LA7SM1 ;VA/DALOI/JMC - Shipping Manifest Options ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,61,1018,1033**;NOV 1, 1997
;
RETRANS ; Retransmit a shipping manifest.
;
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.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA7I,LA7TCNT,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 FDA(62.8,62.801,LA762801,.08)=2
. D FILE^DIE("","FDA(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,X
;
K ^TMP("LA7SMB",$J)
;
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
. ; TMP("LA7SMB",$J,accession area,file 60 test,entry #,specimen,urgency,division, node)
. ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
. F I=0,1,2,5 S ^TMP("LA7SMB",$J,$P(X(0),"^",2),+X(0),X,+$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
;
N LA7I,LA7J,LA7K,LA7L,LA7M
;
K LA7X
;
; Flag to determine if accession/test should be added to manifest.
S LA7FLAG=0
;
; Quit if this asscession area/test not defined for configuration.
I '$D(^TMP("LA7SMB",$J,LA7AA,LA760)) Q
;
S LA7I=0
F S LA7I=$O(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I)) Q:'LA7I D
. S LA7FLAG=0
. D CHKMASK Q:'LA7FLAG
. F LA7J=0,1,2,5 S LA7X(LA7I,LA7J)=$G(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA7K,LA7L,LA7M,LA7J))
;
I $D(LA7X) S LA7FLAG=1
;
Q
;
;
CHKMASK ; Check pattern mask for tests that match on specimen, urgency and division.
;
; Specimen, urgency, and division match
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,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,LA7I,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,LA7I,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,LA7I,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,LA7I,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,LA7I,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,LA7I,0,0,LA7DIV)) S LA7FLAG=1,(LA7K,LA7L)=0,LA7M=LA7DIV Q
;
; Any specimen, urgency or division
I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,0,0)) S LA7FLAG=1,(LA7K,LA7L,LA7M)=0 Q
;
Q
;
;
TASKSM ; Task electronic transmission of manifest
;
N MSG,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
;
;ihs/cmi/maw 02/05/2013 added ZTSAVE("LA7SCFG") for quest configuration
S ZTRTN="BUILD^LA7VORM1("""_+$P(LA7SM,"^")_""")",ZTDESC="E-Transmission of Lab Shipping Manifest"
S ZTSAVE("LA7SM")="",ZTSAVE("LA7SCFG")="",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
LA7SM1 ;VA/DALOI/JMC - Shipping Manifest Options ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,61,1018,1033**;NOV 1, 1997
+2 ;
RETRANS ; Retransmit a shipping manifest.
+1 ;
+2 DO INIT^LA7SM
+3 IF LA7QUIT
DO CLEANUP^LA7SM
QUIT
+4 ;
+5 IF '$PIECE($GET(^LAHM(62.9,+LA7SCFG,0)),"^",7)
Begin DoDot:1
+6 NEW MSG
+7 SET MSG="This shipping configuration "_$PIECE(LA7SCFG,"^",2)_" is not setup for electronic transmission."
+8 DO EN^DDIOL(MSG,"","!?5")
+9 DO CLEANUP^LA7SM
End DoDot:1
QUIT
+10 ;
+11 SET LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"4")
+12 IF LA7SM<0
Begin DoDot:1
+13 DO EN^DDIOL($PIECE(LA7SM,"^",2),"","!?5")
+14 DO CLEANUP^LA7SM
End DoDot:1
QUIT
+15 ;
+16 IF LA7QUIT
Begin DoDot:1
+17 DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+18 DO CLEANUP^LA7SM
End DoDot:1
QUIT
+19 ;
+20 SET LA7SM(0)=$GET(^LAHM(62.8,+LA7SM,0))
+21 ;
+22 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+23 ;
+24 SET DIR(0)="YO"
+25 SET DIR("A")="Sure you want to retransmit this manifest"
SET DIR("B")="NO"
+26 DO ^DIR
+27 IF $DATA(DIRUT)
DO CLEANUP^LA7SM
QUIT
+28 ;
+29 ; Do tasking of transmission
+30 IF Y
DO TASKSM
+31 DO CLEANUP^LA7SM
+32 ;
+33 QUIT
+34 ;
+35 ;
SHIP ; Ship a manifest
+1 ; Used to flag shipping manifest for shipping
+2 ; If electronically connected -> transmit shipping manifest in HL7 message.
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA7I,LA7TCNT,X,Y
+4 ;
+5 SET (LA7I,LA7TCNT)=0
+6 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+7 IF $$CHKTST^LA7SMU(+LA7SM,LA7I)
QUIT
+8 IF $PIECE($GET(^LAHM(62.8,+LA7SM,10,LA7I,0)),"^",8)'=1
QUIT
+9 ; Test ready to ship.
SET LA7TCNT=LA7TCNT+1
+10 DO CHKREQI^LA7SM2(+LA7SM,LA7I)
End DoDot:1
+11 ;
+12 IF 'LA7TCNT
Begin DoDot:1
+13 SET LA7QUIT=1
+14 DO EN^DDIOL("No tests on shipping manifest - Shipping Aborted","","!?5")
End DoDot:1
QUIT
+15 ;
+16 IF $GET(LA7ERR)
Begin DoDot:1
+17 SET LA7QUIT=1
+18 DO EN^DDIOL("Print shipping manifest for complete listing of errors","","!!?5")
+19 DO EN^DDIOL("The following errors were found - Shipping Aborted","","!?5")
+20 SET LA7X=""
+21 FOR
SET LA7X=$ORDER(LA7ERR(LA7X))
IF LA7X=""
QUIT
DO EN^DDIOL(LA7ERR(LA7X),"","!?5")
+22 DO EN^DDIOL("","","!")
End DoDot:1
QUIT
+23 ;
+24 SET DIR(0)="D^::EFRX"
SET DIR("A")="Enter Manifest Shipping Date"
SET DIR("B")="NOW"
+25 DO ^DIR
+26 IF $DATA(DIRUT)
SET LA7QUIT=1
QUIT
+27 SET LA7SDT=Y
+28 DO SMSUP^LA7SMU(LA7SM,4,"SM05^"_LA7SDT)
+29 ;
+30 KILL LA7I
+31 SET LA7I=0
+32 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+33 SET LA7I(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+34 ; Not "pending shipment".
IF $PIECE(LA7I(0),"^",8)'=1
QUIT
+35 ; Change status to "shipped".
+36 SET LA762801=LA7I_","_+LA7SM_","
+37 SET FDA(62.8,62.801,LA762801,.08)=2
+38 DO FILE^DIE("","FDA(62.8)","LA7DIE(2)")
+39 ; Update event file
+40 SET LA7DATA="SM53^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$PIECE(LA7SM,"^",2)
+41 DO SEUP^LA7SMU($PIECE(LA7I(0),"^",5),2,LA7DATA)
End DoDot:1
+42 ;
+43 ; Do tasking of transmission
+44 IF $PIECE($GET(^LAHM(62.9,+LA7SCFG,0)),"^",7)
DO TASKSM
+45 ;
+46 QUIT
+47 ;
+48 ;
SCBLD(LA7SCFG) ; Build test profile for a configuration
+1 ; Call with LA7SCFG = ien of shipping configuration in file #62.9
+2 NEW I,X
+3 ;
+4 KILL ^TMP("LA7SMB",$JOB)
+5 ;
+6 SET X=0
+7 FOR
SET X=$ORDER(^LAHM(62.9,LA7SCFG,60,X))
IF 'X
QUIT
Begin DoDot:1
+8 FOR I=0,1,2,5
SET X(I)=$GET(^LAHM(62.9,LA7SCFG,60,X,I))
+9 ; No accession area - skip
+10 IF '$PIECE(X(0),"^",2)
QUIT
+11 ; TMP("LA7SMB",$J,accession area,file 60 test,entry #,specimen,urgency,division, node)
+12 ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
+13 FOR I=0,1,2,5
SET ^TMP("LA7SMB",$JOB,$PIECE(X(0),"^",2),+X(0),X,+$PIECE(X(0),"^",3),+$PIECE(X(0),"^",4),+$PIECE(X(0),"^",10),I)=X(I)
End DoDot:1
+14 QUIT
+15 ;
+16 ;
SCHK ; Check shipping configuration for test eligible to add.
+1 ; Called by LA7SM, LA7SMB
+2 ;
+3 NEW LA7I,LA7J,LA7K,LA7L,LA7M
+4 ;
+5 KILL LA7X
+6 ;
+7 ; Flag to determine if accession/test should be added to manifest.
+8 SET LA7FLAG=0
+9 ;
+10 ; Quit if this asscession area/test not defined for configuration.
+11 IF '$DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760))
QUIT
+12 ;
+13 SET LA7I=0
+14 FOR
SET LA7I=$ORDER(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+15 SET LA7FLAG=0
+16 DO CHKMASK
IF 'LA7FLAG
QUIT
+17 FOR LA7J=0,1,2,5
SET LA7X(LA7I,LA7J)=$GET(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,LA7K,LA7L,LA7M,LA7J))
End DoDot:1
+18 ;
+19 IF $DATA(LA7X)
SET LA7FLAG=1
+20 ;
+21 QUIT
+22 ;
+23 ;
CHKMASK ; Check pattern mask for tests that match on specimen, urgency and division.
+1 ;
+2 ; Specimen, urgency, and division match
+3 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,LA76805,LA76205,LA7DIV))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=LA76205
SET LA7M=LA7DIV
QUIT
+4 ;
+5 ; Specimen and urgency match; any division
+6 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,LA76805,LA76205,0))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=LA76205
SET LA7M=0
QUIT
+7 ;
+8 ; Specimen and division match; any urgency
+9 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,LA76805,0,LA7DIV))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=0
SET LA7M=LA7DIV
QUIT
+10 ;
+11 ; Specimen match; any urgency/division
+12 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,LA76805,0,0))
SET LA7FLAG=1
SET LA7K=LA76805
SET LA7L=0
SET LA7M=0
QUIT
+13 ;
+14 ; Any specimen; urgency and division match
+15 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,0,LA76205,LA7DIV))
SET LA7FLAG=1
SET LA7K=0
SET LA7L=LA76205
SET LA7M=LA7DIV
QUIT
+16 ;
+17 ; Any specimen and division; urgency match
+18 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,0,LA76205,0))
SET LA7FLAG=1
SET LA7K=0
SET LA7L=LA76205
SET LA7M=0
QUIT
+19 ;
+20 ; Any specimen and urgency; division match
+21 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,0,0,LA7DIV))
SET LA7FLAG=1
SET (LA7K,LA7L)=0
SET LA7M=LA7DIV
QUIT
+22 ;
+23 ; Any specimen, urgency or division
+24 IF $DATA(^TMP("LA7SMB",$JOB,LA7AA,LA760,LA7I,0,0,0))
SET LA7FLAG=1
SET (LA7K,LA7L,LA7M)=0
QUIT
+25 ;
+26 QUIT
+27 ;
+28 ;
TASKSM ; Task electronic transmission of manifest
+1 ;
+2 NEW MSG,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+3 ;
+4 ;ihs/cmi/maw 02/05/2013 added ZTSAVE("LA7SCFG") for quest configuration
+5 SET ZTRTN="BUILD^LA7VORM1("""_+$PIECE(LA7SM,"^")_""")"
SET ZTDESC="E-Transmission of Lab Shipping Manifest"
+6 SET ZTSAVE("LA7SM")=""
SET ZTSAVE("LA7SCFG")=""
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
+7 DO ^%ZTLOAD
+8 ;
+9 SET MSG="Electronic Transmission of Shipping Manifest "_$SELECT($GET(ZTSK):"queued as task# "_ZTSK,1:"NOT queued!")
+10 DO EN^DDIOL(MSG,"","!?5")
+11 ;
+12 QUIT
