- 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