LA7SM1 ;DALOI/JMC - Shipping Manifest Options ;04/13/10 15:00
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,61,74**;Sep 27, 1994;Build 229
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
RETRANS ; Retransmit a shipping manifest.
;
;ZEXCEPT: LA7QUIT,LA7SCFG,LA7SM
;
D INIT^LA7SM
I LA7QUIT D CLEANUP^LA7SM Q
;
I '$P($G(^LAHM(62.9,+LA7SCFG,0)),"^",7) D Q
. N MSG
. S MSG="This shipping configuration "_$P(LA7SCFG,"^",2)_" is not setup for electronic transmission."
. D EN^DDIOL(MSG,"","!?5")
. D CLEANUP^LA7SM
;
S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"4")
I LA7SM<0 D Q
. D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
. D CLEANUP^LA7SM
;
I LA7QUIT D Q
. D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
. D CLEANUP^LA7SM
;
S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
S DIR(0)="YO"
S DIR("A")="Sure you want to retransmit this manifest",DIR("B")="NO"
D ^DIR
I $D(DIRUT) D CLEANUP^LA7SM Q
;
; Do tasking of transmission
I Y D TASKSM
D CLEANUP^LA7SM
;
Q
;
;
SHIP ; Ship a manifest
; Used to flag shipping manifest for shipping
; If electronically connected -> transmit shipping manifest in HL7 message.
;
;ZEXCEPT: LA7QUIT,LA7SCFG,LA7SM
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA762801,LA7DATA,LA7ERR,LA7FDA,LA7I,LA7SDT,LA7TCNT,LA7X,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
. D EN^DDIOL("No tests on shipping manifest - Shipping Aborted","","!?5")
;
I $G(LA7ERR) D Q
. S LA7QUIT=1
. D EN^DDIOL("Print shipping manifest for complete listing of errors","","!!?5")
. 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=Y
D SMSUP^LA7SMU(LA7SM,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 LA7FDA(62.8,62.801,LA762801,.08)=2
. D FILE^DIE("","LA7FDA(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
;
;
SCBLD(LA7SCFG) ; Build test profile for a configuration
; Call with LA7SCFG = ien of shipping configuration in file #62.9
N I,J,K,X
;
K ^TMP("LA7SMB",$J),^TMP("LA7SMB-R",$J)
;
; ^TMP("LA7SMB",$J,accession area,file 60 test,specimen,urgency,division,node)
; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
;
; When accession/test need to have been received via an inter-divisional manifest (feeder shipping configuration) before re-shipment
; ^TMP("LA7SMB-R",$J,feeder shipping conf,accession area,file 60 test,specimen,urgency,division,node)
; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
;
; If feeder configurations then build "LA7SMB-R" node.
; If no feeder configurations then build "LA7SMB" node.
;
S X=0
F S X=$O(^LAHM(62.9,LA7SCFG,60,X)) Q:'X D
. F I=0,1,2,5 S X(I)=$G(^LAHM(62.9,LA7SCFG,60,X,I))
. ; No accession area - skip
. I '$P(X(0),"^",2) Q
. S ^TMP("LA7SMB",$J,$P(X(0),"^",2),+X(0))=""
. I $O(^LAHM(62.9,LA7SCFG,60,X,6,0)) D Q
. . S J=0
. . F S J=$O(^LAHM(62.9,LA7SCFG,60,X,6,J)) Q:'J D
. . . S K=+^LAHM(62.9,LA7SCFG,60,X,6,J,0)
. . . F I=0,1,2,5 S ^TMP("LA7SMB-R",$J,K,$P(X(0),"^",2),+X(0),+$P(X(0),"^",3),+$P(X(0),"^",4),+$P(X(0),"^",10),I)=X(I)
. F I=0,1,2,5 S ^TMP("LA7SMB",$J,$P(X(0),"^",2),+X(0),+$P(X(0),"^",3),+$P(X(0),"^",4),+$P(X(0),"^",10),I)=X(I)
Q
;
;
SCHK ; Check shipping configuration for test eligible to add.
; Called by LA7SM, LA7SMB
;
;ZEXCEPT: LA760,LA7629,LA7AA,LA7FLAG,LA7X
;
N LA7J,LA7K,LA7L,LA7M
;
K LA7X
; Flag to determine if accession/test should be added to manifest
S LA7FLAG=0
;
; ^TMP("LA7SMB",$J,accession area,file 60 test,specimen,urgency,division, node)
; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
; Quit if this accession area/test not defined for configuration.
I '$P(LA760(0),"^",10) D Q
. I '$D(^TMP("LA7SMB",$J,LA7AA,LA760)) Q
. D CHKMASK
. I LA7FLAG F LA7J=0,1,2,5 S LA7X(LA7J)=$G(^TMP("LA7SMB",$J,LA7AA,LA760,LA7K,LA7L,LA7M,LA7J))
;
; ^TMP("LA7SMB-R",$J,feeder shipping conf,accession area,file 60 test,specimen,urgency,division,node)
; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
; Quit if this accession area/test not defined for this and feeder configurations .
I $P(LA760(0),"^",10) D Q
. S LA7629=$P($G(^LAHM(62.8,$P(LA760(0),"^",10),0)),"^",2)
. I '$D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760)) Q
. D CHKMASKR
. I LA7FLAG F LA7J=0,1,2,5 S LA7X(LA7J)=$G(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,LA7K,LA7L,LA7M,LA7J))
;
Q
;
;
CHKMASK ; Check pattern mask for tests that match on specimen, urgency and division.
;
; ^TMP("LA7SMB",$J,accession area,file 60 test,specimen,urgency,division, node)
; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
;
;ZEXCEPT: LA760,LA76205,LA7629,LA76805,LA7AA,LA7DIV,LA7FLAG,LA7K,LA7L,LA7M
;
;
; Specimen, urgency, and division match
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA76805,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=LA7DIV Q
;
; Specimen and urgency match; any division
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA76805,LA76205,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=0 Q
;
; Specimen and division match; any urgency
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA76805,0,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=LA7DIV Q
;
; Specimen match; any urgency/division
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA76805,0,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=0 Q
;
; Any specimen; urgency and division match
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,0,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=LA7DIV Q
;
; Any specimen and division; urgency match
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,0,LA76205,0)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=0 Q
;
; Any specimen and urgency; division match
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,0,0,LA7DIV)) S LA7FLAG=1,(LA7K,LA7L)=0,LA7M=LA7DIV Q
;
; Any specimen, urgency or division
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,0,0,0)) S LA7FLAG=1,(LA7K,LA7L,LA7M)=0 Q
;
Q
;
;
CHKMASKR ; Check pattern mask for re-shipped tests that match on specimen, urgency and division.
;
; ^TMP("LA7SMB-R",$J,feeder shipping conf,accession area,file 60 test,specimen,urgency,division,node)
; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
;
;ZEXCEPT: LA760,LA76205,LA7629,LA76805,LA7AA,LA7DIV,LA7FLAG,LA7K,LA7L,LA7M
;
; Specimen, urgency, and division match
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,LA76805,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=LA7DIV Q
;
; Specimen and urgency match; any division
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,LA76805,LA76205,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=0 Q
;
; Specimen and division match; any urgency
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,LA76805,0,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=LA7DIV Q
;
; Specimen match; any urgency/division
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,LA76805,0,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=0 Q
;
; Any specimen; urgency and division match
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,0,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=LA7DIV Q
;
; Any specimen and division; urgency match
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,0,LA76205,0)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=0 Q
;
; Any specimen and urgency; division match
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,0,0,LA7DIV)) S LA7FLAG=1,(LA7K,LA7L)=0,LA7M=LA7DIV Q
;
; Any specimen, urgency or division
I $D(^TMP("LA7SMB-R",$J,LA7629,LA7AA,LA760,0,0,0)) S LA7FLAG=1,(LA7K,LA7L,LA7M)=0 Q
;
Q
;
;
TASKSM ; Task electronic transmission of manifest
;
;ZEXCEPT: LA7SM
;
N MSG,ZTDESC,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
;
;
CHKOLOC(LA7AA,LA7AD,LA7AN,LA7SCFG) ; Check ordering location.
; If shipping configuration has specific ordering locations then check accession to determine if it's one of them
;
; Call with LA7AA = ien of accession area.
; LA7AD = accession date
; LA7AN = accession number
; LA7SCFG = ien of shipping configuration (file #62.9)
;
; Returns LA7FLAG = 0 (accession's ordering location not on list)
; = 1 (accession's ordering location on list)
; = 2 (no ordering locations screen on this shipping configuration)
;
N LA7FLAG,ORDERLOCATION
;
S ORDERLOCATION=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",13)
S LA7FLAG=2
;
; Site has specified specific ordering locations for this shipping configuration
I $D(^LAHM(62.9,LA7SCFG,44,"AL")) D
. I ORDERLOCATION,$D(^LAHM(62.9,LA7SCFG,44,"AL",ORDERLOCATION)) S LA7FLAG=1
. E S LA7FLAG=0
;
Q LA7FLAG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SM1 10008 printed Dec 13, 2024@01:39:25 Page 2
LA7SM1 ;DALOI/JMC - Shipping Manifest Options ;04/13/10 15:00
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,61,74**;Sep 27, 1994;Build 229
+2 ;
+3 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+4 ; used in conjunction with Eclipse M-editor.
+5 ;
RETRANS ; Retransmit a shipping manifest.
+1 ;
+2 ;ZEXCEPT: LA7QUIT,LA7SCFG,LA7SM
+3 ;
+4 DO INIT^LA7SM
+5 IF LA7QUIT
DO CLEANUP^LA7SM
QUIT
+6 ;
+7 IF '$PIECE($GET(^LAHM(62.9,+LA7SCFG,0)),"^",7)
Begin DoDot:1
+8 NEW MSG
+9 SET MSG="This shipping configuration "_$PIECE(LA7SCFG,"^",2)_" is not setup for electronic transmission."
+10 DO EN^DDIOL(MSG,"","!?5")
+11 DO CLEANUP^LA7SM
End DoDot:1
QUIT
+12 ;
+13 SET LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"4")
+14 IF LA7SM<0
Begin DoDot:1
+15 DO EN^DDIOL($PIECE(LA7SM,"^",2),"","!?5")
+16 DO CLEANUP^LA7SM
End DoDot:1
QUIT
+17 ;
+18 IF LA7QUIT
Begin DoDot:1
+19 DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+20 DO CLEANUP^LA7SM
End DoDot:1
QUIT
+21 ;
+22 SET LA7SM(0)=$GET(^LAHM(62.8,+LA7SM,0))
+23 ;
+24 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+25 ;
+26 SET DIR(0)="YO"
+27 SET DIR("A")="Sure you want to retransmit this manifest"
SET DIR("B")="NO"
+28 DO ^DIR
+29 IF $DATA(DIRUT)
DO CLEANUP^LA7SM
QUIT
+30 ;
+31 ; Do tasking of transmission
+32 IF Y
DO TASKSM
+33 DO CLEANUP^LA7SM
+34 ;
+35 QUIT
+36 ;
+37 ;
SHIP ; Ship a manifest
+1 ; Used to flag shipping manifest for shipping
+2 ; If electronically connected -> transmit shipping manifest in HL7 message.
+3 ;
+4 ;ZEXCEPT: LA7QUIT,LA7SCFG,LA7SM
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA762801,LA7DATA,LA7ERR,LA7FDA,LA7I,LA7SDT,LA7TCNT,LA7X,X,Y
+7 ;
+8 SET (LA7I,LA7TCNT)=0
+9 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+10 IF $$CHKTST^LA7SMU(+LA7SM,LA7I)
QUIT
+11 IF $PIECE($GET(^LAHM(62.8,+LA7SM,10,LA7I,0)),"^",8)'=1
QUIT
+12 ; Test ready to ship.
SET LA7TCNT=LA7TCNT+1
+13 DO CHKREQI^LA7SM2(+LA7SM,LA7I)
End DoDot:1
+14 ;
+15 IF 'LA7TCNT
Begin DoDot:1
+16 SET LA7QUIT=1
+17 DO EN^DDIOL("No tests on shipping manifest - Shipping Aborted","","!?5")
End DoDot:1
QUIT
+18 ;
+19 IF $GET(LA7ERR)
Begin DoDot:1
+20 SET LA7QUIT=1
+21 DO EN^DDIOL("Print shipping manifest for complete listing of errors","","!!?5")
+22 DO EN^DDIOL("The following errors were found - Shipping Aborted","","!?5")
+23 SET LA7X=""
+24 FOR
SET LA7X=$ORDER(LA7ERR(LA7X))
if LA7X=""
QUIT
DO EN^DDIOL(LA7ERR(LA7X),"","!?5")
+25 DO EN^DDIOL("","","!")
End DoDot:1
QUIT
+26 ;
+27 SET DIR(0)="D^::EFRX"
SET DIR("A")="Enter Manifest Shipping Date"
SET DIR("B")="NOW"
+28 DO ^DIR
+29 IF $DATA(DIRUT)
SET LA7QUIT=1
QUIT
+30 SET LA7SDT=Y
+31 DO SMSUP^LA7SMU(LA7SM,4,"SM05^"_LA7SDT)
+32 ;
+33 KILL LA7I
+34 SET LA7I=0
+35 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+36 SET LA7I(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+37 ; Not "pending shipment".
IF $PIECE(LA7I(0),"^",8)'=1
QUIT
+38 ; Change status to "shipped".
+39 SET LA762801=LA7I_","_+LA7SM_","
+40 SET LA7FDA(62.8,62.801,LA762801,.08)=2
+41 DO FILE^DIE("","LA7FDA(62.8)","LA7DIE(2)")
+42 ; Update event file
+43 SET LA7DATA="SM53^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$PIECE(LA7SM,"^",2)
+44 DO SEUP^LA7SMU($PIECE(LA7I(0),"^",5),2,LA7DATA)
End DoDot:1
+45 ;
+46 ; Do tasking of transmission
+47 IF $PIECE($GET(^LAHM(62.9,+LA7SCFG,0)),"^",7)
DO TASKSM
+48 ;
+49 QUIT
+50 ;
+51 ;
SCBLD(LA7SCFG) ; Build test profile for a configuration
+1 ; Call with LA7SCFG = ien of shipping configuration in file #62.9
+2 NEW I,J,K,X
+3 ;
+4 KILL ^TMP("LA7SMB",$JOB),^TMP("LA7SMB-R",$JOB)
+5 ;
+6 ; ^TMP("LA7SMB",$J,accession area,file 60 test,specimen,urgency,division,node)
+7 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+8 ;
+9 ; When accession/test need to have been received via an inter-divisional manifest (feeder shipping configuration) before re-shipment
+10 ; ^TMP("LA7SMB-R",$J,feeder shipping conf,accession area,file 60 test,specimen,urgency,division,node)
+11 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+12 ;
+13 ; If feeder configurations then build "LA7SMB-R" node.
+14 ; If no feeder configurations then build "LA7SMB" node.
+15 ;
+16 SET X=0
+17 FOR
SET X=$ORDER(^LAHM(62.9,LA7SCFG,60,X))
if 'X
QUIT
Begin DoDot:1
+18 FOR I=0,1,2,5
SET X(I)=$GET(^LAHM(62.9,LA7SCFG,60,X,I))
+19 ; No accession area - skip
+20 IF '$PIECE(X(0),"^",2)
QUIT
+21 SET ^TMP("LA7SMB",$JOB,$PIECE(X(0),"^",2),+X(0))=""
+22 IF $ORDER(^LAHM(62.9,LA7SCFG,60,X,6,0))
Begin DoDot:2
+23 SET J=0
+24 FOR
SET J=$ORDER(^LAHM(62.9,LA7SCFG,60,X,6,J))
if 'J
QUIT
Begin DoDot:3
+25 SET K=+^LAHM(62.9,LA7SCFG,60,X,6,J,0)
+26 FOR I=0,1,2,5
SET ^TMP("LA7SMB-R",$JOB,K,$PIECE(X(0),"^",2),+X(0),+$PIECE(X(0),"^",3),+$PIECE(X(0),"^",4),+$PIECE(X(0),"^",10),I)=X(I)
End DoDot:3
End DoDot:2
QUIT
+27 FOR I=0,1,2,5
SET ^TMP("LA7SMB",$JOB,$PIECE(X(0),"^",2),+X(0),+$PIECE(X(0),"^",3),+$PIECE(X(0),"^",4),+$PIECE(X(0),"^",10),I)=X(I)
End DoDot:1
+28 QUIT
+29 ;
+30 ;
SCHK ; Check shipping configuration for test eligible to add.
+1 ; Called by LA7SM, LA7SMB
+2 ;
+3 ;ZEXCEPT: LA760,LA7629,LA7AA,LA7FLAG,LA7X
+4 ;
+5 NEW LA7J,LA7K,LA7L,LA7M
+6 ;
+7 KILL LA7X
+8 ; Flag to determine if accession/test should be added to manifest
+9 SET LA7FLAG=0
+10 ;
+11 ; ^TMP("LA7SMB",$J,accession area,file 60 test,specimen,urgency,division, node)
+12 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+13 ; Quit if this accession area/test not defined for configuration.
+14 IF '$PIECE(LA760(0),"^",10)
Begin DoDot:1
+15 IF '$DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760))
QUIT
+16 DO CHKMASK
+17 IF LA7FLAG
FOR LA7J=0,1,2,5
SET LA7X(LA7J)=$GET(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7K,LA7L,LA7M,LA7J))
End DoDot:1
QUIT
+18 ;
+19 ; ^TMP("LA7SMB-R",$J,feeder shipping conf,accession area,file 60 test,specimen,urgency,division,node)
+20 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+21 ; Quit if this accession area/test not defined for this and feeder configurations .
+22 IF $PIECE(LA760(0),"^",10)
Begin DoDot:1
+23 SET LA7629=$PIECE($GET(^LAHM(62.8,$PIECE(LA760(0),"^",10),0)),"^",2)
+24 IF '$DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760))
QUIT
+25 DO CHKMASKR
+26 IF LA7FLAG
FOR LA7J=0,1,2,5
SET LA7X(LA7J)=$GET(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,LA7K,LA7L,LA7M,LA7J))
End DoDot:1
QUIT
+27 ;
+28 QUIT
+29 ;
+30 ;
CHKMASK ; Check pattern mask for tests that match on specimen, urgency and division.
+1 ;
+2 ; ^TMP("LA7SMB",$J,accession area,file 60 test,specimen,urgency,division, node)
+3 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+4 ;
+5 ;ZEXCEPT: LA760,LA76205,LA7629,LA76805,LA7AA,LA7DIV,LA7FLAG,LA7K,LA7L,LA7M
+6 ;
+7 ;
+8 ; Specimen, urgency, and division match
+9 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA76805,LA76205,LA7DIV))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=LA76205
SET LA7M=LA7DIV
QUIT
+10 ;
+11 ; Specimen and urgency match; any division
+12 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA76805,LA76205,0))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=LA76205
SET LA7M=0
QUIT
+13 ;
+14 ; Specimen and division match; any urgency
+15 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA76805,0,LA7DIV))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=0
SET LA7M=LA7DIV
QUIT
+16 ;
+17 ; Specimen match; any urgency/division
+18 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA76805,0,0))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=0
SET LA7M=0
QUIT
+19 ;
+20 ; Any specimen; urgency and division match
+21 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,0,LA76205,LA7DIV))
SET LA7FLAG=1
SET LA7K=0
SET LA7L=LA76205
SET LA7M=LA7DIV
QUIT
+22 ;
+23 ; Any specimen and division; urgency match
+24 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,0,LA76205,0))
SET LA7FLAG=1
SET LA7K=0
SET LA7L=LA76205
SET LA7M=0
QUIT
+25 ;
+26 ; Any specimen and urgency; division match
+27 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,0,0,LA7DIV))
SET LA7FLAG=1
SET (LA7K,LA7L)=0
SET LA7M=LA7DIV
QUIT
+28 ;
+29 ; Any specimen, urgency or division
+30 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,0,0,0))
SET LA7FLAG=1
SET (LA7K,LA7L,LA7M)=0
QUIT
+31 ;
+32 QUIT
+33 ;
+34 ;
CHKMASKR ; Check pattern mask for re-shipped tests that match on specimen, urgency and division.
+1 ;
+2 ; ^TMP("LA7SMB-R",$J,feeder shipping conf,accession area,file 60 test,specimen,urgency,division,node)
+3 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+4 ;
+5 ;ZEXCEPT: LA760,LA76205,LA7629,LA76805,LA7AA,LA7DIV,LA7FLAG,LA7K,LA7L,LA7M
+6 ;
+7 ; Specimen, urgency, and division match
+8 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,LA76805,LA76205,LA7DIV))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=LA76205
SET LA7M=LA7DIV
QUIT
+9 ;
+10 ; Specimen and urgency match; any division
+11 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,LA76805,LA76205,0))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=LA76205
SET LA7M=0
QUIT
+12 ;
+13 ; Specimen and division match; any urgency
+14 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,LA76805,0,LA7DIV))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=0
SET LA7M=LA7DIV
QUIT
+15 ;
+16 ; Specimen match; any urgency/division
+17 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,LA76805,0,0))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=0
SET LA7M=0
QUIT
+18 ;
+19 ; Any specimen; urgency and division match
+20 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,0,LA76205,LA7DIV))
SET LA7FLAG=1
SET LA7K=0
SET LA7L=LA76205
SET LA7M=LA7DIV
QUIT
+21 ;
+22 ; Any specimen and division; urgency match
+23 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,0,LA76205,0))
SET LA7FLAG=1
SET LA7K=0
SET LA7L=LA76205
SET LA7M=0
QUIT
+24 ;
+25 ; Any specimen and urgency; division match
+26 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,0,0,LA7DIV))
SET LA7FLAG=1
SET (LA7K,LA7L)=0
SET LA7M=LA7DIV
QUIT
+27 ;
+28 ; Any specimen, urgency or division
+29 IF $DATA(^TMP("LA7SMB-R",$JOB,LA7629,LA7AA,LA760,0,0,0))
SET LA7FLAG=1
SET (LA7K,LA7L,LA7M)=0
QUIT
+30 ;
+31 QUIT
+32 ;
+33 ;
TASKSM ; Task electronic transmission of manifest
+1 ;
+2 ;ZEXCEPT: LA7SM
+3 ;
+4 NEW MSG,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+5 ;
+6 SET ZTRTN="BUILD^LA7VORM1("""_+$PIECE(LA7SM,"^")_""")"
SET ZTDESC="E-Transmission of Lab Shipping Manifest"
+7 SET ZTSAVE("LA7SM")=""
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
+8 DO ^%ZTLOAD
+9 ;
+10 SET MSG="Electronic Transmission of Shipping Manifest "_$SELECT($GET(ZTSK):"queued as task# "_ZTSK,1:"NOT queued!")
+11 DO EN^DDIOL(MSG,"","!?5")
+12 ;
+13 QUIT
+14 ;
+15 ;
CHKOLOC(LA7AA,LA7AD,LA7AN,LA7SCFG) ; Check ordering location.
+1 ; If shipping configuration has specific ordering locations then check accession to determine if it's one of them
+2 ;
+3 ; Call with LA7AA = ien of accession area.
+4 ; LA7AD = accession date
+5 ; LA7AN = accession number
+6 ; LA7SCFG = ien of shipping configuration (file #62.9)
+7 ;
+8 ; Returns LA7FLAG = 0 (accession's ordering location not on list)
+9 ; = 1 (accession's ordering location on list)
+10 ; = 2 (no ordering locations screen on this shipping configuration)
+11 ;
+12 NEW LA7FLAG,ORDERLOCATION
+13 ;
+14 SET ORDERLOCATION=$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",13)
+15 SET LA7FLAG=2
+16 ;
+17 ; Site has specified specific ordering locations for this shipping configuration
+18 IF $DATA(^LAHM(62.9,LA7SCFG,44,"AL"))
Begin DoDot:1
+19 IF ORDERLOCATION
IF $DATA(^LAHM(62.9,LA7SCFG,44,"AL",ORDERLOCATION))
SET LA7FLAG=1
+20 IF '$TEST
SET LA7FLAG=0
End DoDot:1
+21 ;
+22 QUIT LA7FLAG
