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

BLRAG09C.m

Go to the documentation of this file. 
  1. BLRAG09C ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCS ; NOV 20, 2012
  1.  ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
  1.  ;from LA7SM
  1.  ;  BLR REF LAB USING LEDI   - UL^BLRAG02      = return the value of the 'REF LAB USING LEDI?' field in the BLR MASTER CONTROL file
  1.  ;  BLR ICD LOOKUP           - ICDLKUP^BLRAG07 = ICD code lookup
  1.  ;  BLR ORDER REASON LKUP    - ORL^BLRAG07     = return order reasons from file 100.03
  1.  ;  BLR PATIENT LOOKUP       - PTLK^BLRAG04    = Patient Lookup
  1.  ;  BLR PRINTERS AVAILABLE   - DEVICE^BLRAG10  = return available printers from the DEVICE file
  1.  ;  BLR USER LOOKUP          - NP^BLRAG06      = return entries from the NEW PERSON table 200 that are 'active'
  1.  ;
  1.  ;  BLR ACCESSION            - ACC^BLRAG05     = lab accession processor
  1.  ;  BLR ACCESSION PRINT      - ABR^BLRAG02     = reprint accession label or manifest
  1.  ;  BLR ALL NON-ACCESSIONED  - ANA^BLRAG01     = return all non-accessioned lab records
  1.  ;  BLR ALL-ACCESSIONED      - ABD^BLRAG02     = return all accessioned records for given date range
  1.  ;  BLR COLLECTION INFO      - BLC^BLRAG06     = check BLR PT CONFIRM parameter and return insurances for patient
  1.  ;  BLR DELETE TEST          - DELTST^BLRAG08  = Cancel tests - Test are no longer deleted, instead the status is changed to Not Performed.
  1.  ;  BLR ORDER/TEST STATUS    - LROS^BLRAG03    = return order/test status for given patient and date range
  1.  ;
  1.  ;  BLR SHIP CONF            - SC^BLRAG09A     = select a shipping configuration
  1.  ;  BLR MANIFEST BUILD       - BM^BLRAG09B     = build a shipping manifest
  1.  ;  BLR MANIFEST CLOSE/SHIP  - CLSHIP^BLRAG09C = Close/ship a shipping manifest
  1.  ;  BLR MANIFEST DISPLAY     - DISP^BLRAG09G   = screen formatted text for manifest display
  1.  ;  BLR MANIFEST START       - SMONLY^BLRAG09C = Start a shipping manifest only, no building
  1.  ;  BLR MANIFEST TEST ADD    - ADDTEST^BLRAG09C= Add tests to an existing manifest\
  1.  ;  BLR MANIFEST TEST REMOVE - REMVTST^BLRAG09C= Remove a test from manifest - actually flags test as "removed".
  1.  ;  BLR MANIFEST TESTS TO ADD- TARPC^BLRAG09B  = return tests that can be added to a manifest
  1.  ;
  1. CLSHIP(BLRY,BLRSCFG,BLRSM,BLRCSF,BLRSHTIM,BLRDEV) ; Close/ship a shipping manifest
  1.  ; BLR MANIFEST CLOSE/SHIP rpc
  1.  ;INPUT:
  1.  ; BLRSCFG  = (required) Shipping Configuration pointer to the
  1.  ;             LAB SHIPPING CONFIGURATION file 62.9
  1.  ; BLRSM    = (required) Shipping Manifest pointer to the
  1.  ;             LAB SHIPPING MANIFEST file 62.8
  1.  ; BLRCSF   = (optional) close/ship manifest flag
  1.  ;             0=print manifest only (default)
  1.  ;             1=close manifest
  1.  ;             2=ship manifest
  1.  ;              if manifest status=3 (closed), only ship or print manifest is allowed
  1.  ; BLRSHTIM = Manifest Ship date/time in external format
  1.  ; BLRDEV  = Printer for Manifest printing - IEN pointer to the DEVICE file
  1.  ;             No printing will occur if null or undefined in the DEVICE file
  1.  ;
  1.  ;RETURNS:
  1.  ; MESSAGE
  1.  ;
  1.  N BLRI
  1.  D ^XBKVAR S X="ERROR^BLRAG09C",@^%ZOSF("TRAP")
  1.  S BLRI=0
  1.  K ^TMP("BLRAG",$J)
  1.  S BLRY=$$TMPGLB^BLRAGUT()
  1.  ;            0
  1.  S @BLRY@(0)="ERROR_ID"
  1.  ;
  1.  N BLREF,BLRTXT
  1.  S BLRTXT=""
  1.  S (BLREF,BLREFF)=0
  1.  D INIT
  1.  ;I LA7QUIT D CLEANUP Q
  1.  S LA7SM=BLRSM   ;manifest
  1.  D LOCKSM
  1.  I LA7QUIT D  Q
  1.  . D UNLOCKSM,CLEANUP
  1.  S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MSG,X,Y
  1.  S LA7ST=+$G(BLRCSF)
  1.  I BLRCSF=1 D
  1.  .D SMSUP^LA7SMU(LA7SM_U_$P(LA7SM(0),U,1),3,"SM04") ; Close manifest
  1.  .S BLRTXT="MANIFEST "_$P(LA7SM(0),U,1)_" has been closed."
  1.  I BLRCSF=2 D
  1.  .D SHIP        ; Ship Manifest
  1.  .I MSG'="" S BLRTXT=$S(BLRTXT'="":BLRTXT_" ",1:"")_MSG  ;LA7QUIT
  1.  .S BLREFF=+BLREF
  1.  ;print manifest
  1.  I ('BLRCSF)!$G(BLRDEV) D DEV^BLRAG09F($G(BLRDEV))  ;print manifest
  1.  I $P($G(BLREF),U,1)=-1 S BLRTXT=$S(BLRTXT'="":BLRTXT_" ",1:"")_" Error printing manifest# "_$P(LA7SM(0),U,1)_"." S BLREFF=1
  1.  S:$G(BLREFF)'=1 @BLRY@(0)="MESSAGE"
  1.  S BLRI=BLRI+1 S @BLRY@(BLRI)=BLRTXT
  1.  D UNLOCKSM,CLEANUP
  1.  Q
  1.  ;
  1. SHIP ; Ship a manifest only called from CLSHIP
  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.  . S MSG="No tests on shipping manifest - Shipping Aborted"
  1.  . S BLREF=1
  1.  ;
  1.  I $G(LA7ERR) D  Q
  1.  . S LA7QUIT=1
  1.  . S MSG="Print shipping manifest for complete listing of errors"
  1.  . S BLREF=1
  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=$G(BLRSHTIM)
  1.  D SMSUP^LA7SMU(LA7SM_U_$P(LA7SM(0),U,1),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. TASKSM ; Task electronic transmission of manifest  called from SHIP
  1.  ;
  1.  N ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  ;
  1.  S ZTRTN="BUILD^LA7VORM1("""_+$P(LA7SM,"^")_""")",ZTDESC="E-Transmission of Lab Shipping Manifest"
  1.  S ZTSAVE("LA7SM")="",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.  Q
  1.  ;
  1. ERR(BLRERR) ;Error processing
  1.  ; BLRERR = Error text OR error code
  1.  ; BLRI   = pointer into return global array
  1.  D UNLOCKSM,CLEANUP
  1.  S BLRI=BLRI+1
  1.  S ^TMP("BLRAG",$J,BLRI)=BLRERR_$C(30)
  1.  ;S BLRI=BLRI+1
  1.  ;S ^TMP("BLRAG",$J,BLRI)=$C(31)
  1.  Q
  1.  ;
  1. ERROR ;
  1.  D ENTRYAUD^BLRUTIL("ERROR^BLRAG09C 0.0")  ; Store Error data
  1.  NEW ERRORMSG
  1.  S ERRORMSG="$"_"Z"_"E=""ERROR^BLRAG09C"""  ; BYPASS SAC Checker
  1.  S @ERRORMSG  D ^%ZTER
  1.  D ERR("RPMS Error")
  1.  Q
  1.  ;
  1. ADDTEST(BLRY,BLRSCFG,BLRSM,BLRTAL) ; Add tests to an existing manifest
  1.  ; BLR MANIFEST TEST ADD rpc
  1.  ;INPUT:
  1.  ; BLRSCFG = Shipping Configuration pointer to the
  1.  ;            LAB SHIPPING CONFIGURATION file 62.9
  1.  ; BLRSM  = Shipping Manifest pointer to the LAB SHIPPING MANIFEST
  1.  ;           file 62.8
  1.  ; BLRTAL = List of tests to be added to manifest separated by pipe:
  1.  ;  TEST_IEN_":"_TEST_NAME_":"_UID_":"_EXT_ACC_#_":"_AREA_":"_DATE_":"
  1.  ;  _ACC_#|...
  1.  ;     TEST_IEN  = pointer to LABORATORY TEST file 60
  1.  ;     TEST_NAME = Text from NAME field in LABORATORY TEST file 60
  1.  ;     UID       = Test Unique ID
  1.  ;     EXT_ACC_# = External accession number
  1.  ;     AREA      = area pointer into file 68
  1.  ;     DATE      = date pointer into file 68
  1.  ;     ACC_#     = accession # pointer into file 68
  1.  ;     PAT_DFN   = Patient IEN pointer to the VA Patient file 2
  1.  ;     PAT_NAM   = Patient name
  1.  ;     CONFIG_NAM = Shipping Configuration Name
  1.  ;RETURNS:
  1.  ; TEST_ON_MANIF ^ ADDABLE_TESTS
  1.  ;  TESTS_ON_MANIF = List of tests on manifest separated by pipe:
  1.  ;                   See MTL^BLRAG09A
  1.  ;  ADDABLE_TESTS  = List of tests that can be added separated by pipe:
  1.  ;                   See TA^BLRAG9B
  1.  N BLRI
  1.  D ^XBKVAR S X="ERROR^BLRAGUT",@^%ZOSF("TRAP")
  1.  S BLRI=0
  1.  K ^TMP("BLRAG",$J)
  1.  S BLRY=$$TMPGLB^BLRAGUT()
  1.  S @BLRY@(0)="ERROR_ID"
  1.  ;
  1.  N BLRJ,BLRTSTL
  1.  N LA760,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
  1.  S LA7SCFG=BLRSCFG
  1.  S LA7SM=BLRSM
  1.  S BLRTSTL=""
  1.  S LA7QUIT=0
  1.  ;
  1.  F BLRJ=1:1:$L(BLRTAL,"|") D
  1.  .S LA760=$P($P(BLRTAL,"|",BLRJ),":",1)   ;test pointer to file 60
  1.  .S LA7UID=$P($P(BLRTAL,"|",BLRJ),":",3)  ;UID
  1.  .S LA7AA=$P($P(BLRTAL,"|",BLRJ),":",5)   ;accession area
  1.  .S LA7AD=$P($P(BLRTAL,"|",BLRJ),":",6)   ;accession date
  1.  .S LA7AN=$P($P(BLRTAL,"|",BLRJ),":",7)   ;accession number (internal)
  1.  .S LA760(0)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))   ;Test's zeroth node
  1.  .I $P(LA760(0),"^",5) S LA7QUIT="1^Test already completed" Q  ; Test completed - skip
  1.  .S LA76205=+$P(LA760(0),"^",2)   ; Test urgency
  1.  .I LA76205>49 S LA76205=$S(LA76205=50:9,1:LA76205-50)
  1.  .; Specimen type
  1.  .S LA76805=0 S X=+$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0)) I X S LA76805=+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
  1.  .I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3 S LA7QUIT="1^Cannot select controls" Q  ; Don't build controls
  1.  .S LA7I=0
  1.  .F  S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I  D  Q:LA7QUIT
  1.  .. N X
  1.  .. S X(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
  1.  .. I $P(X(0),"^",2)=LA760,$P(X(0),"^",8)'=0 S LA7QUIT="1^Test already on shipping manifest"
  1.  .I LA7QUIT Q
  1.  .D SCBLD^LA7SM1(+LA7SCFG)   ; Build TMP global with test profile
  1.  .S LA7DIV=+$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^")  ; Accession's division
  1.  .D SCHK^LA7SM1   ; Check if test eligible for manifest
  1.  .I 'LA7FLAG S LA7QUIT="1^Test not selectable for this configuration" Q
  1.  .D LOCK68^LA7SMB
  1.  .S LA7I=0
  1.  .F  S LA7I=$O(LA7X(LA7I)) Q:'LA7I  D ADD^LA7SMB
  1.  .D UNLOCK68^LA7SMB
  1.  D MTL^BLRAG09A(.BLRTSTL,BLRSM) ;get tests already on manifest
  1.  S BLRNTAL=$$TA^BLRAG09B(BLRSCFG,BLRSM)  ;get test that can be added to manifest
  1.  ;            0              1
  1.  S @BLRY@(0)="TESTS_ON_MANIF^ADDABLE_TESTS"
  1.  S BLRI=BLRI+1 S @BLRY@(BLRI)=BLRTSTL_U_BLRNTAL
  1.  Q
  1.  ;
  1.  ;
  1. REMVTST(BLRY,BLRSM,BLRMTL) ; Remove a test from manifest - actually flags test as "removed".
  1.  ; BLR MANIFEST TEST REMOVE rpc
  1.  ;INPUT:
  1.  ;   BLRSM      = Manifest IEN pointer to LAB SHIPPING MANIFEST file 62.8
  1.  ;   BLRMTL      = List of manifest tests separated by pipe:
  1.  ;                     TEST_IEN:TEST_NAME:TEST_SPEC_PTR|...
  1.  ;                   TEST_IEN  = pointer to LABORATORY TEST file 60
  1.  ;                   TEST_NAME = Text from NAME field in
  1.  ;                                LABORATORY TEST file 60
  1.  ;                   TEST_SPECIMEN_PTR = Specimen pointer
  1.  ;                                   pointer to SPECIMENS multiple of
  1.  ;                                    LAB SHIPPING MANIFEST file 62.8
  1.  ;RETURNS:
  1.  ;   ERROR_ID ^ MESSAGE ^ MANIFEST_TESTL ^ ADDABLE_TESTS
  1.  ;    ERROR_ID       = 0=test removed
  1.  ;                     1=error removing test
  1.  ;    MESSAGE        = Text message describing error
  1.  ;    MANIFEST_TESTL = Remaining List of manifest tests separated by pipe:
  1.  ;                     See MTL^BLRAG09A
  1.  ;   ADDABLE_TESTS  = List of tests that can be added separated by pipe:
  1.  ;                    See TA^BLRAG09B
  1.  N BLRI
  1.  D ^XBKVAR S X="ERROR^BLRAGUT",@^%ZOSF("TRAP")
  1.  S BLRI=0
  1.  K ^TMP("BLRAG",$J)
  1.  S BLRY=$$TMPGLB^BLRAGUT()
  1.  S @BLRY@(0)="ERROR_ID"
  1.  ;
  1.  N BLRCNT,BLRJ,BLRTSTL
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
  1.  S BLRTSTL=""
  1.  S LA7SM=BLRSM
  1.  ;build LA760 array
  1.  K LA760
  1.  S BLRCNT=0
  1.  F BLRJ=1:1:$L(BLRMTL,"|") D
  1.  .S BLRCNT=BLRCNT+1
  1.  .S LA760(BLRCNT)=$P($P(BLRMTL,"|",BLRJ),":",3)_U_$G(^LAHM(62.8,+$G(BLRSM),10,$P($P(BLRMTL,"|",BLRJ),":",3),0))
  1.  ;
  1.  S LA7X="" F  S LA7X=$O(LA760(LA7X)) Q:LA7X=""  D
  1.  .N FDA,LA7628,LA768,LA7DATA
  1.  .S LA762801="" F  S LA762801=$O(^LAHM(62.8,+LA7SM,10,"UID",+(LA760(LA7X)),LA762801)) Q:LA762801=""  Q:$P($G(^LAHM(62.8,LA7SM,10,LA762801,0)),U,8)'=0
  1.  .I LA762801'="" D
  1.  ..S LA762801=LA762801_","_+LA7SM_","
  1.  ..S FDA(62.8,62.801,LA762801,.08)=0
  1.  ..D FILE^DIE("","FDA(62.8)","LA7DIE(2)") ; "Remove" test from shipping manifest
  1.  ..; Update event file
  1.  ..S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_""    ;$P(LA7SM,"^",2) no associated manifest for GUI
  1.  ..S LA7UID=$P(LA760(LA7X),"^",6)  ;get SPECIMEN ID (UID) (add 1 to piece number)
  1.  ..D SEUP^LA7SMU(LA7UID,2,LA7DATA)
  1.  ..; Update accession
  1.  ..D ACCSUP^LA7SMU(LA7UID,$P(LA760(LA7X),"^",3),"@")
  1.  D MTL^BLRAG09A(.BLRTSTL,BLRSM) ;get tests on Manifest
  1.  S BLRSCFG=$P($G(^LAHM(62.8,BLRSM,0)),U,2)
  1.  S BLRNTAL=$$TA^BLRAG09B(BLRSCFG,BLRSM)  ;get test that can be added to manifest
  1.  ;            0        1       2              3
  1.  S @BLRY@(0)="CLEAN^MESSAGE^MANIFEST_TESTL^ADDABLE_TESTS"
  1.  ;                            0   1    2         3
  1.  S BLRI=BLRI+1 S @BLRY@(BLRI)=0_U_""_U_BLRTSTL_U_BLRNTAL
  1.  Q
  1.  ;
  1. INIT ; Initialize variables
  1.  S DT=$$DT^XLFDT
  1.  S LA7QUIT=0
  1.  S LA7SCFG=BLRSCFG  ;shipping configuration
  1.  ;I LA7SCFG<1 S LA7QUIT=1 Q
  1.  S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
  1.  S MSG=""
  1.  K ^TMP("LA7ERR",$J)
  1.  Q
  1.  ;
  1.  ;
  1. LOCKSM ; Lock entry in file 62.8
  1.  L +^LAHM(62.8,+LA7SM):1 ; Set lock.
  1.  I '$T S LA7QUIT="1^Someone else is editing this shipping manifest"
  1.  Q
  1.  ;
  1.  ;
  1. UNLOCKSM ; Unlock entry in file 62.8
  1.  L -^LAHM(62.8,+LA7SM) ; Release lock.
  1.  Q
  1.  ;
  1.  ;
  1. CLEANUP ; Cleanup variables
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  K DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  K LA7AA,LA7ACTON,LA7AD,LA7AN,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7ST,LA7UID,LA7X,LA7YARRY
  1.  K LA760,LA76205,LA762801,LA76805
  1.  K ^TMP("LA7ERR",$J)
  1.  Q