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

LA7SM1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. RETRANS ; Retransmit a shipping manifest.
  1. ;
  1. D INIT^LA7SM
  1. I LA7QUIT D CLEANUP^LA7SM Q
  1. ;
  1. I '$P($G(^LAHM(62.9,+LA7SCFG,0)),"^",7) D Q
  1. . N MSG
  1. . S MSG="This shipping configuration "_$P(LA7SCFG,"^",2)_" is not setup for electronic transmission."
  1. . D EN^DDIOL(MSG,"","!?5")
  1. . D CLEANUP^LA7SM
  1. ;
  1. S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"4")
  1. I LA7SM<0 D Q
  1. . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
  1. . D CLEANUP^LA7SM
  1. ;
  1. I LA7QUIT D Q
  1. . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. . D CLEANUP^LA7SM
  1. ;
  1. S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ;
  1. S DIR(0)="YO"
  1. S DIR("A")="Sure you want to retransmit this manifest",DIR("B")="NO"
  1. D ^DIR
  1. I $D(DIRUT) D CLEANUP^LA7SM Q
  1. ;
  1. ; Do tasking of transmission
  1. I Y D TASKSM
  1. D CLEANUP^LA7SM
  1. ;
  1. Q
  1. ;
  1. ;
  1. SHIP ; Ship a manifest
  1. ; Used to flag shipping manifest for shipping
  1. ; If electronically connected -> transmit shipping manifest in HL7 message.
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA7I,LA7TCNT,X,Y
  1. ;
  1. S (LA7I,LA7TCNT)=0
  1. F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
  1. . I $$CHKTST^LA7SMU(+LA7SM,LA7I) Q
  1. . I $P($G(^LAHM(62.8,+LA7SM,10,LA7I,0)),"^",8)'=1 Q
  1. . S LA7TCNT=LA7TCNT+1 ; Test ready to ship.
  1. . D CHKREQI^LA7SM2(+LA7SM,LA7I)
  1. ;
  1. I 'LA7TCNT D Q
  1. . S LA7QUIT=1
  1. . D EN^DDIOL("No tests on shipping manifest - Shipping Aborted","","!?5")
  1. ;
  1. I $G(LA7ERR) D Q
  1. . S LA7QUIT=1
  1. . D EN^DDIOL("Print shipping manifest for complete listing of errors","","!!?5")
  1. . D EN^DDIOL("The following errors were found - Shipping Aborted","","!?5")
  1. . S LA7X=""
  1. . F S LA7X=$O(LA7ERR(LA7X)) Q:LA7X="" D EN^DDIOL(LA7ERR(LA7X),"","!?5")
  1. . D EN^DDIOL("","","!")
  1. ;
  1. S DIR(0)="D^::EFRX",DIR("A")="Enter Manifest Shipping Date",DIR("B")="NOW"
  1. D ^DIR
  1. I $D(DIRUT) S LA7QUIT=1 Q
  1. S LA7SDT=Y
  1. D SMSUP^LA7SMU(LA7SM,4,"SM05^"_LA7SDT)
  1. ;
  1. K LA7I
  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)'=1 Q ; Not "pending shipment".
  1. . ; Change status to "shipped".
  1. . S LA762801=LA7I_","_+LA7SM_","
  1. . S FDA(62.8,62.801,LA762801,.08)=2
  1. . D FILE^DIE("","FDA(62.8)","LA7DIE(2)")
  1. . ; Update event file
  1. . S LA7DATA="SM53^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$P(LA7SM,"^",2)
  1. . D SEUP^LA7SMU($P(LA7I(0),"^",5),2,LA7DATA)
  1. ;
  1. ; Do tasking of transmission
  1. I $P($G(^LAHM(62.9,+LA7SCFG,0)),"^",7) D TASKSM
  1. ;
  1. Q
  1. ;
  1. ;
  1. SCBLD(LA7SCFG) ; Build test profile for a configuration
  1. ; Call with LA7SCFG = ien of shipping configuration in file #62.9
  1. N I,X
  1. ;
  1. K ^TMP("LA7SMB",$J)
  1. ;
  1. S X=0
  1. F S X=$O(^LAHM(62.9,LA7SCFG,60,X)) Q:'X D
  1. . F I=0,1,2,5 S X(I)=$G(^LAHM(62.9,LA7SCFG,60,X,I))
  1. . ; No accession area - skip
  1. . I '$P(X(0),"^",2) Q
  1. . ; TMP("LA7SMB",$J,accession area,file 60 test,entry #,specimen,urgency,division, node)
  1. . ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
  1. . 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)
  1. Q
  1. ;
  1. ;
  1. SCHK ; Check shipping configuration for test eligible to add.
  1. ; Called by LA7SM, LA7SMB
  1. ;
  1. N LA7I,LA7J,LA7K,LA7L,LA7M
  1. ;
  1. K LA7X
  1. ;
  1. ; Flag to determine if accession/test should be added to manifest.
  1. S LA7FLAG=0
  1. ;
  1. ; Quit if this asscession area/test not defined for configuration.
  1. I '$D(^TMP("LA7SMB",$J,LA7AA,LA760)) Q
  1. ;
  1. S LA7I=0
  1. F S LA7I=$O(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I)) Q:'LA7I D
  1. . S LA7FLAG=0
  1. . D CHKMASK Q:'LA7FLAG
  1. . F LA7J=0,1,2,5 S LA7X(LA7I,LA7J)=$G(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA7K,LA7L,LA7M,LA7J))
  1. ;
  1. I $D(LA7X) S LA7FLAG=1
  1. ;
  1. Q
  1. ;
  1. ;
  1. CHKMASK ; Check pattern mask for tests that match on specimen, urgency and division.
  1. ;
  1. ; Specimen, urgency, and division match
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=LA7DIV Q
  1. ;
  1. ; Specimen and urgency match; any division
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,LA76205,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=0 Q
  1. ;
  1. ; Specimen and division match; any urgency
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,0,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=LA7DIV Q
  1. ;
  1. ; Specimen match; any urgency/division
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,0,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=0 Q
  1. ;
  1. ; Any specimen; urgency and division match
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=LA7DIV Q
  1. ;
  1. ; Any specimen and division; urgency match
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,LA76205,0)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=0 Q
  1. ;
  1. ; Any specimen and urgency; division match
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,0,LA7DIV)) S LA7FLAG=1,(LA7K,LA7L)=0,LA7M=LA7DIV Q
  1. ;
  1. ; Any specimen, urgency or division
  1. I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,0,0)) S LA7FLAG=1,(LA7K,LA7L,LA7M)=0 Q
  1. ;
  1. Q
  1. ;
  1. ;
  1. TASKSM ; Task electronic transmission of manifest
  1. ;
  1. N MSG,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. ;
  1. ;ihs/cmi/maw 02/05/2013 added ZTSAVE("LA7SCFG") for quest configuration
  1. S ZTRTN="BUILD^LA7VORM1("""_+$P(LA7SM,"^")_""")",ZTDESC="E-Transmission of Lab Shipping Manifest"
  1. S ZTSAVE("LA7SM")="",ZTSAVE("LA7SCFG")="",ZTIO="",ZTDTH=$$NOW^XLFDT
  1. D ^%ZTLOAD
  1. ;
  1. S MSG="Electronic Transmission of Shipping Manifest "_$S($G(ZTSK):"queued as task# "_ZTSK,1:"NOT queued!")
  1. D EN^DDIOL(MSG,"","!?5")
  1. ;
  1. Q