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

LA7SMU.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1. CHKSM(X) ; Shipping manifest status check
  1.  ; Call with X = ien of file #62.9 LAB SHIPPING CONFIGURATION
  1.  ; Returns -1 = error^reason
  1.  ;          0 = no active shipping manifest exists
  1.  ;         >0 = ien of active shipping manifest in file #62.8, LAB SHIPPING MANIFEST
  1.  ;
  1.  ; No value passed
  1.  I '$G(X) Q "-1^No configuration passed"
  1.  ; Bad pointer passed
  1.  I '$D(^LAHM(62.9,X,0)) Q "-1^Bad configuration pointer"
  1.  ; Get ien of active shipping manifest.
  1.  S Y=+$O(^LAHM(62.8,"AC1",X,0))
  1.  I Y S Y=Y_"^"_$P(^LAHM(62.8,Y,0),"^")
  1.  Q Y
  1.  ;
  1.  ;
  1. CSM(LA7SCFG) ; Creates a new shipping manifest
  1.  ; Call with X = ien of file #62.9 LAB SHIPPING CONFIGURATION
  1.  ; Returns -1 = error^reason
  1.  ;          0 = no active shipping manifest exists
  1.  ;         >0 = ien of active shipping manifest in file #62.8, LAB SHIPPING MANIFEST
  1.  ;
  1.  N DATA,FDA,I,LA7CF,LA7DIE,LA7DT,LA7IEN,LA7SM,X,X4
  1.  ;
  1.  ; No value passed
  1.  I '$G(LA7SCFG) Q "-1^No configuration passed"
  1.  ;
  1.  ; Bad pointer passed
  1.  I '$D(^LAHM(62.9,LA7SCFG,0)) Q "-1^Bad configuration pointer"
  1.  ;
  1.  S LA7SCFG(0)=$G(^LAHM(62.9,LA7SCFG,0))
  1.  ; ien of collecting facility
  1.  S LA7CF=$P(LA7SCFG(0),"^",2)
  1.  ; file #4 INSTITUTION information
  1.  F I=.01,.05,99 S X4(I)=$$GET1^DIQ(4,LA7CF_",",I)
  1.  ;
  1.  ; Get station number else use short name
  1.  S LA7SM=""
  1.  I $L(X4(99)) S LA7SM=X4(99)
  1.  E  S LA7SM=X4(.05)
  1.  ; Failsafe value
  1.  I LA7SM="" S LA7SM="INST:"_LA7CF
  1.  S DT=$$DT^XLFDT,LA7DT=$E($$FMTHL7^XLFDT(DT),1,8)
  1.  S LA7SM=LA7SM_"-"_LA7DT_"-"
  1.  ;
  1.  ;L +^LAHM(62.8,0):5 ; Set lock
  1.  D LOCK^DILF("^LAHM(62.8,0)")
  1.  I '$T Q "-1^Unable to obtain lock on file LAB SHIPPING MANIFEST #62.8"
  1.  S X=0
  1.  F  S X=X+1 Q:'$D(^LAHM(62.8,"B",LA7SM_X))
  1.  S LA7SM=LA7SM_X
  1.  ;
  1.  S FDA(1,62.8,"+1,",.01)=LA7SM
  1.  S FDA(1,62.8,"+1,",.02)=LA7SCFG
  1.  S FDA(1,62.8,"+1,",.03)=1
  1.  I $P(LA7SCFG(0),"^",8) S FDA(1,62.8,"+1,",.04)=$P(LA7SCFG(0),"^",8)
  1.  S FDA(1,62.8,"+1,",.05)=+$P(LA7SCFG(0),"^",15)
  1.  S FDA(1,62.8,"+1,",.06)=+$P(LA7SCFG(0),"^",16)
  1.  D UPDATE^DIE("","FDA(1)","LA7IEN","LA7DIE(1)")
  1.  D RECALL^DILFD(62.8,LA7IEN(1)_",",DUZ)
  1.  ;
  1.  S DATA="SM01^"_$$NOW^XLFDT
  1.  D SEUP(LA7SM,1,DATA)
  1.  ;
  1.  S DATA="SM02^"_$$NOW^XLFDT
  1.  D SEUP(LA7SM,1,DATA)
  1.  ;
  1.  ; Release lock
  1.  L -^LAHM(62.8,0)
  1.  Q LA7IEN(1)_"^"_LA7SM
  1.  ;
  1.  ;
  1. SMSUP(LA7SM,LA7ST,LA7EVNC) ; Shipping manifest status update.
  1.  ; Call with LA7SM = ien of entry in file #62.8 LAB SHIPPING MAINFEST^.01 field
  1.  ;           LA7ST = status to update
  1.  ;         LA7EVNC = event code^event date/time (default=NOW)
  1.  ;
  1.  N DATA,LA7DIE,LA7FDA,LA7IEN
  1.  ;
  1.  S LA7IEN(1)=+LA7SM
  1.  S LA7FDA(2,62.8,+LA7SM_",",.03)=LA7ST
  1.  D UPDATE^DIE("","LA7FDA(2)","LA7IEN","LA7DIE(2)")
  1.  S DATA=$P(LA7EVNC,"^")_"^"_$S($P(LA7EVNC,"^",2):$P(LA7EVNC,"^",2),1:$$NOW^XLFDT)
  1.  D SEUP($P(LA7SM,"^",2),1,DATA)
  1.  Q
  1.  ;
  1.  ;
  1. STSUP(LA7SM,LA762801,LA7DATA) ; Shipping test status update
  1.  ; Call with    LA7SM = ien of shipping manifest (#62.8)
  1.  ;           LA762801 = ien of test entry on shipping manifest
  1.  ;            LA7DATA = data to be filed
  1.  N LA7FDA,LA7DIE
  1.  S LA762801=LA762801_","_+LA7SM_","
  1.  S LA7FDA(62.8,62.801,LA762801,.08)=LA7DATA
  1.  D FILE^DIE("","LA7FDA(62.8)","LA7DIE(2)")
  1.  Q
  1.  ;
  1.  ;
  1. SEUP(LA7ID,LA7EVN,LA7DATA) ; Shipping event update
  1.  ; Call with LA7ID = shipping identifier (manifest invoice # or UID)
  1.  ;           LA7EVN = event type (1=shipping manifest/2=test)
  1.  ;           LA7DATA = data to be filed
  1.  N FDA,I,LA7IEN,X
  1.  ;L +^LAHM(62.85,0) ; Set lock
  1.  D LOCK^DILF("^LAHM(62.85,0)")
  1.  I '$T Q
  1.  S FDA(3,62.85,"+1,",.01)=LA7ID
  1.  S FDA(3,62.85,"+1,",.02)=$S($G(DUZ)>0:DUZ,1:.5)
  1.  S FDA(3,62.85,"+1,",.03)=$$NOW^XLFDT
  1.  S FDA(3,62.85,"+1,",.04)=LA7EVN
  1.  I $P(LA7DATA,"^")'="" D
  1.  . S X=$$EVNC($P(LA7DATA,"^"))
  1.  . I X S FDA(3,62.85,"+1,",.05)=+X
  1.  F I=2:1:4 I $P(LA7DATA,"^",I)'="" S FDA(3,62.85,"+1,",$P("^.07^.08^.09","^",I))=$P(LA7DATA,"^",I)
  1.  ;
  1.  ; Add event to lab shipping event.
  1.  D UPDATE^DIE("","FDA(3)","LA7IEN","LA7DIE(3)")
  1.  ; Release lock
  1.  L -^LAHM(62.85,0)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. ACCSUP(LA7UID,LA760,LA7DATA) ; Accession status update
  1.  ; Call with LA7UID = UID of accession to update
  1.  ;          LA7DATA = value to update (pointer to file #62.8, LAB SHIPPING MANIFEST or "@" to delete
  1.  ;
  1.  N FDA,LA7AA,LA7AD,LA7AN,LA7CAD,LA768,X
  1.  S X=$Q(^LRO(68,"C",LA7UID))
  1.  S LA7AA=$QS(X,4),LA7AD=$QS(X,5),LA7AN=$QS(X,6)
  1.  S LA7AD=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),U,3) ; Start with original accession date in case roll over accession.
  1.  S LA7CAD=$$AD^LA7SUTL(LA7AA) ; Get current accession date for this accession area.
  1.  S LA7AD=$S(LA7AD>0:LA7AD-.000000001,1:0)
  1.  F  S LA7AD=$O(^LRO(68,LA7AA,1,LA7AD)) Q:'LA7AD!(LA7AD>LA7CAD)  D
  1.  . I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN)) Q
  1.  . I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")'=LA7UID Q
  1.  . I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760)) Q  ; Test not on accession.
  1.  . S LA768=LA760_","_LA7AN_","_LA7AD_","_LA7AA_","
  1.  . S FDA(68,68.04,LA768,9)=LA7DATA
  1.  . D FILE^DIE("","FDA(68)","LA7DIE(68)")
  1.  Q
  1.  ;
  1.  ;
  1. SELSM(LA7SCFG,LA7SCR) ; Select shipping manifest
  1.  ; Call with LA7SCFG = ien of file #62.9 LAB SHIPPING CONFIGURATION
  1.  ;            LA7SCR = comma delimited list of status screen - only allow selection of manifests with matching status
  1.  ;      Returns LA7Y = pointer to shipping manifest or error
  1.  N D,DIC,DTOUT,DUOUT,LA7Y,X,Y
  1.  S DIC="^LAHM(62.8,",DIC(0)="AEQ",DIC("A")="Select Shipping Manifest: "
  1.  S DIC("S")="I $P(^LAHM(62.8,Y,0),U,2)=LA7SCFG"
  1.  S DIC("W")="D SMW^LA7SMU1(Y)"
  1.  I $G(LA7SCR)'="" S DIC("S")=DIC("S")_","""_LA7SCR_"""[$P(^LAHM(62.8,Y,0),U,3)"
  1.  S D="C"
  1.  D MIX^DIC1
  1.  I Y<1 S LA7Y="-1^"
  1.  E  S LA7Y=Y
  1.  Q LA7Y
  1.  ;
  1.  ;
  1. SMED(LA7SM,LA7EVC) ; Determine shipping manifest's event date
  1.  ; Call with LA7SM = ien of entry in file #62.8 LAB SHIPPING MANIFEST
  1.  ;          LA7EVC = event type code
  1.  ;   Returns LA7Y = internal event date^external event date
  1.  N LA7I,LA7X,LA7Y
  1.  I '$G(LA7SM) Q "-1^No shipping manifest passed"
  1.  S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1.  S LA7EV=+$$EVNC(LA7EVC)
  1.  I LA7EVC="SM05",$P(LA7SM(0),"^",3)'>2 Q "0^Shipping manifest has not been shipped"
  1.  S LA7I=0,LA7Y=""
  1.  F  S LA7I=$O(^LAHM(62.85,"B",$P(LA7SM(0),"^"),LA7I)) Q:'LA7I  D  Q:$L(LA7Y)
  1.  . I $P($G(^LAHM(62.85,LA7I,0)),"^",5)'=LA7EV Q
  1.  . S LA7Y=$P(^LAHM(62.85,LA7I,0),"^",7)_"^"_$$FMTE^XLFDT($P(^LAHM(62.85,LA7I,0),"^",7),"M") ; Event date/time
  1.  I $G(LA7Y)="" S LA7Y="-2^No event date found"
  1.  Q LA7Y
  1.  ;
  1.  ;
  1. EVNC(LA7EVC) ; Resolve an event code to it's pointer/text(.01) value
  1.  ; Call with LA7EVC = Code to lookup, i.e. SM01, SM50
  1.  ;        Returns Y = ien of code in file #64.061, LAB ELECTRONIC CODES.
  1.  N X,Y
  1.  S (X,Y)=0
  1.  F  S X=$O(^LAB(64.061,"F",LA7EVC,X)) Q:'X  D  Q:Y
  1.  . S X(0)=$G(^LAB(64.061,X,0))
  1.  . I $P(X(0),"^",7)="E" S Y=X_"^"_$P(X(0),"^")
  1.  I 'Y S Y="0^Code not on file"
  1.  Q Y
  1.  ;
  1.  ;
  1. CHKTST(LA7SM,LA762801) ; Check and update if test is still valid.
  1.  ; Call with LA7SM = ien of shipping manifest in file #62.8
  1.  ;        LA762801 = ien of entry on test multiple in file #62.8
  1.  ;
  1.  ; Returns LA7SKIP = 0 (Test still on accession).
  1.  ;                   1 (Test not on accession).
  1.  ;                   2 (Accession deleted/purged).
  1.  ;                   3 (Test not on accession - already shipped)
  1.  ;                   4 (Accession deleted/purged - already shipped)
  1.  ;
  1.  N LA7AA,LA7AD,LA7AN,LA7DATA,LA7SKIP,LA7UID,X,Y
  1.  S LA7SKIP=0
  1.  S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1.  S LA762801(0)=$G(^LAHM(62.8,+LA7SM,10,+LA762801,0))
  1.  S LA7UID=$P(LA762801(0),"^",5)
  1.  S X=$Q(^LRO(68,"C",LA7UID))
  1.  S LA7AA=+$QS(X,4),LA7AD=+$QS(X,5),LA7AN=+$QS(X,6)
  1.  ;
  1.  ; Test found.
  1.  I $D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,+$P(LA762801(0),"^",2),0)) Q LA7SKIP
  1.  ; Accession missing.
  1.  I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)) D
  1.  . ; Already shipped
  1.  . I $P(LA7SM(0),"^",3)>4 S LA7SKIP=4 Q
  1.  . S LA7SKIP=2,LA7DATA="SM62"
  1.  ;
  1.  ; Test missing.
  1.  I 'LA7SKIP,'$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,+$P(LA762801(0),"^",2),0)) D
  1.  . ; Already shipped
  1.  . I $P(LA7SM(0),"^",3)>4 S LA7SKIP=3 Q
  1.  . S LA7SKIP=1,LA7DATA="SM61"
  1.  ;
  1.  ; Update manifest/event file if test has not shipped.
  1.  I LA7SKIP,LA7SKIP<3 D
  1.  . ; Update test on manifest
  1.  . D STSUP^LA7SMU(+LA7SM,LA762801,0)
  1.  . ; Update event file
  1.  . S LA7DATA=LA7DATA_"^"_$$NOW^XLFDT_"^"_$P(LA762801(0),"^",2)_"^"_$P(LA7SM(0),"^")
  1.  . D SEUP^LA7SMU(LA7UID,2,LA7DATA)
  1.  Q LA7SKIP