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

LA7SMP0.m

Go to the documentation of this file. 
  1. LA7SMP0 ;VA/DALOI/JMC - Shipping Manifest Print (Cont'd);JUL 06, 2010 3:14 PM
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997;Build 9
  1.  ;
  1. HED ; Header
  1.  I $E(IOST,1,2)="C-" D TERM Q:$G(LA7EXIT)
  1.  I LA7PAGE W @IOF S $X=0
  1.  S LA7PAGE=LA7PAGE+1
  1.  I +LA7SMST'=4,IOM<132 D WARN
  1.  ;
  1.  W !,?1,"Shipping Manifest: ",$P(LA7SM,"^",2)
  1.  I +LA7SMST'=4,IOM'<132 D WARN
  1.  ;
  1.  W ?IOM-37," Page: ",LA7PAGE
  1.  W !,?11,"to Site: ",LA7TSITE
  1.  W ?IOM-40," Printed: ",LA7NOW
  1.  W !,?9,"from Site: ",LA7FSITE
  1.  ;
  1.  I +LA7SMST=4 W !,?6,"Date Shipped: ",$P(LA7SDT,"^",2)
  1.  E  W !,?12,"Status: ",$P(LA7SMST,"^",2)
  1.  W ?IOM-41," Ship via: ",LA7SVIA
  1.  ;
  1.  ; Check if task has been asked to stop.
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD D  Q
  1.  . S (LA7EXIT,ZTSTOP)=1
  1.  . W !!,"*** Report requested to stop by TaskMan ***"
  1.  . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
  1.  ;
  1.  ; Print shipping receipt
  1.  I $P(LA7SMR,"^",2) D  Q
  1.  . W !,LA7LINE
  1.  . I $P(LA7SMR,"^",2)=2 W !!,"Following Required Information and/or Test Codes Missing",!!
  1.  ;
  1.  W !,"Shipping Condition: ",$S(LA7SCOND:$$GET1^DIQ(62.93,LA7SCOND_",",.01),1:"None Specified")
  1.  W ?(IOM-42)," Container: ",$S(LA7SCONT:$$GET1^DIQ(62.91,LA7SCONT_",",.01),1:"None Specified")
  1.  ;
  1.  ;I $L($P(LA7SCFG(0),"^",13)) W !,?4,"Account Number: ",$P(LA7SCFG(0),"^",13)  ;cmi/maw 7/6/2010 orig line moved under insurance
  1.  ;
  1.  I LA7SBC D SBC1
  1.  ;W !!,?11,"Patient Name",?41,"Patient ID",?64,"Accession"  ;cmi/maw 7/6/2010 orig line
  1.  W !!,?11,"Patient Name",?41,"Patient ID",?64,"Lab Reference #"  ;cmi/maw 7/6/2010 reference lab
  1.  I IOM>131 W ?86,"Requested By"
  1.  W !,?11,"Date of Birth",?41,"Sex",?64,"Specimen UID"
  1.  I IOM>131 W ?86,"Collect Date/Time"
  1.  I IOM'>131 W !,?11,"Requested By",?41,"Collect Date/Time"
  1.  W !,LA7LINE
  1.  Q
  1.  ;
  1.  ;
  1. SH ; Subheader
  1.  W !,"Item: ",LA7ITEM
  1.  W ?11,PNM
  1.  ;I LRDPF=2,LA7ICN W ?41,LA7ICN
  1.  ;E  W ?41,$S(LRDPF=2:SSN,1:SSN(2))
  1.  ;W ?41,$S(LRDPF=2:SSN,1:SSN(2))  ;cmi/maw 7/6/2010 orig line
  1.  W ?41,$S(LRDPF=2:$$HRN^AUPNPAT(DFN,DUZ(2)),1:"")
  1.  ;cmi/maw 7/6/2010 replace above with HRN
  1.  ;W ?64,LA7ACC  ;cmi/maw 7/6/2010 orig line
  1.  W ?64,$$GETORDA^LA7VORM1(LA7UID)  ;cmi/maw 7/6/2010 ref lab now order number
  1.  I IOM>131 W ?86,$P(LA7PROV,"^",2)
  1.  W !
  1.  I LA7DC W "Cont'd"
  1.  W ?11,$$FMTE^XLFDT(DOB),?41,$S(SEX="M":"Male",SEX="F":"Female",SEX="":"Unknown",1:SEX),?64,LA7UID
  1.  ;I IOM'>131 W !,?11,$E($P(LA7PROV,"^",2),1,28),?41,$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)  ;cmi/maw 7/6/2010 orig line
  1.  I IOM'>131 W !,?11,$$GET1^DIQ(200,$P(LA7PROV,"^"),41.99)_"-"_$E($P(LA7PROV,"^",2),1,19),?41,$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)  ;cmi/maw 7/6/2010 for NPI
  1.  I IOM>131 W ?86,$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)
  1.  W !
  1.  I +LA7SMST'=4 D
  1.  . D PROV(+LA7PROV)
  1.  . I $P($G(LA762801(0)),"^",6) D
  1.  . . S X=$$GET1^DIQ(62.91,$P(LA762801(0),"^",6),.01)
  1.  . . W !,?11,"Specimen Container: ",X
  1.  ;
  1.  ; Print collection sample if micro
  1.  I $G(LA7AA),$P($G(^LRO(68,LA7AA,0)),"^",2)="MI" W !,?11,"Collection sample: ",$P(LA762(0),"^")
  1.  ;
  1.  S LA7X=$G(^TMP("LA7SMRI",$J,LA7SCOND,LA7SCONT,LA7UID,1))
  1.  I $P(LA7X,"^") D
  1.  . W !,?11,"Patient Height: ",$P(LA7X,"^",2)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",3)_",",.01)
  1.  I $P(LA7X,"^",4) D
  1.  . I $P(LA7X,"^") W ?40
  1.  . E  W !,?11
  1.  . W "Patient Weight: ",$P(LA7X,"^",5)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",6)_",",.01)
  1.  ;
  1.  S LA7X=$G(^TMP("LA7SMRI",$J,LA7SCOND,LA7SCONT,LA7UID,2))
  1.  I $P(LA7X,"^") D
  1.  . W !,?11,"Collection Volume: ",$P(LA7X,"^",2)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",3)_",",.01)
  1.  I $P(LA7X,"^",8) D
  1.  . I $P(LA7X,"^") W ?40
  1.  . E  W !,?11
  1.  . W "Collection Weight: ",$P(LA7X,"^",9)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",10)_",",.01)
  1.  I $P(LA7X,"^",4) D
  1.  . W !,?11,"Collection End Date/Time: ",$$FMTE^XLFDT($P(LA7X,"^",5),"1M")
  1.  . W "  (Duration: ",$P(LA7X,"^",6)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",7)_",",.01),")"
  1.  ;
  1.  I LA7SBC D SBC2
  1.  S LA7DC=0
  1.  Q
  1.  ;
  1.  ;
  1. WARN ; Write warning for work copy.
  1.  W ?$S(IOM<131:5,1:40),"*** DO NOT USE FOR SHIPPING DOCUMENT - WORK COPY ONLY ***"
  1.  Q
  1.  ;
  1.  ;
  1. SBC1 ; Site bar codes
  1.  ;
  1.  ; Print "SM" bar code
  1.  ; Calculate/append LPC to barcode. 
  1.  I $G(LA7SM("BARCODE"))="" D
  1.  . N LA7X,X,Y
  1.  . I LA7SBC=1 D
  1.  . . S LA7X="STX^SITE^"_LA7FSITE(99)_"^"_$P($G(LA7SDT),"^")_"^"_$P(LA7SM,"^",2)_"^ETX"
  1.  . I LA7SBC=2 D
  1.  . .S LA7X="SITE^"_LA7FSITE(99)_"^"_$P($G(LA7SDT),"^")_"^"_$P(LA7SM,"^",2)_"^"
  1.  . S X=LA7X X ^%ZOSF("LPC") S LA7SM("LPC")=Y,LA7SM("BARCODE")=LA7X_Y
  1.  ;
  1.  W !,?18,"SM: ",$$BC128^LA7SBC(LA7SM("BARCODE"),1,60,"","",2),!
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SBC2 ; Patient bar codes
  1.  ;
  1.  N LA7SDATA
  1.  ;
  1.  ; Print "PD" bar code
  1.  I LA7SBC=1 D
  1.  . S LA7SDATA="STX^PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_$G(SEX)_"^"_LA7CDT_"^ETX"_$G(LA7SM("LPC"))
  1.  ;
  1.  I LA7SBC=2 D
  1.  . S LA7SDATA="PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_LA7CDT_"^"_$G(LA7SM("LPC"))
  1.  ;
  1.  W !!,?18,"PD: ",$$BC128^LA7SBC(LA7SDATA,1,60,"","",2),!
  1.  W !,?11,$E(LA7LINE,1,69)
  1.  ;
  1.  ; Print "PD1" bar code
  1.  I LA7SBC=1 D
  1.  . S LA7SDATA="STX^PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^ETX"_$G(LA7SM("LPC"))
  1.  I LA7SBC=2 D
  1.  . S LA7SDATA="PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^"_SEX_"^"_$G(LA7SM("LPC"))
  1.  ;
  1.  W !,?$S(IOM<131:18,1:50),"PD1: ",$$BC128^LA7SBC(LA7SDATA,1,60,"","",2),!
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CMT ; Print comments on manifest
  1.  ;
  1.  N LA7I
  1.  F LA7I=1:1:LA7CMT D  Q:LA7EXIT
  1.  . I ($Y+4)>IOSL D  Q:LA7EXIT
  1.  . . I LA7PAGE W ! D WARN
  1.  . . D HED
  1.  . W !,?11,LA7CMT(LA7I,0)
  1.  Q
  1.  ;
  1.  ;
  1. OCMT(UID) ;now check here for order comment
  1.  ;ihs/cmi/maw 07/26/2011 added for ref lab
  1.  N ORD,ORDI,ORDD,ORDA,ORDB
  1.  S ORD=$$GETORDA^LA7VORM1(UID)
  1.  Q:'ORD
  1.  S ORDD=$O(^LRO(69,"C",ORD,0))
  1.  Q:'ORDD
  1.  S ORDI=0 F  S ORDI=$O(^LRO(69,ORDD,1,ORDI)) Q:'ORDI  D
  1.  . S ORDA=0 F  S ORDA=$O(^LRO(69,ORDD,1,ORDI,2,ORDA)) Q:'ORDA  D
  1.  .. Q:$G(^LRO(69,ORDD,1,ORDI,2,ORDA,.3))'=UID
  1.  .. S ORDB=0 F  S ORDB=$O(^LRO(69,ORDD,1,ORDI,2,ORDA,1,ORDB)) Q:'ORDB  D
  1.  ... W !,?11,$G(^LRO(69,ORDD,1,ORDI,2,ORDA,1,ORDB,0))
  1.  Q
  1.  ;
  1. PTID ; Get/setup patient identifier information
  1.  ;
  1.  S DFN=+$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2) D PT^LRX
  1.  ;
  1.  ; Integration control number (ICN) from MPI
  1.  S LA7ICN=""
  1.  S X="MPIF001" X ^%ZOSF("TEST")
  1.  I $T,LRDPF=2 D
  1.  . S LA7ICN=$$GETICN^MPIF001(DFN)
  1.  . I LA7ICN<1 S LA7ICN=""
  1.  Q
  1.  ;
  1.  ;
  1. PROV(LA7OP) ; Print ordering provider contact on working copy
  1.  ; Call with LA7OP = provider's file #200 ien
  1.  ;
  1.  N LRERR,X,Y
  1.  I LA7OP D GETS^DIQ(200,LA7OP_",",".132;.137;.138","E","LA7OP(LA7OP)","LRERR")
  1.  I '$D(LA7OP(LA7OP)) Q
  1.  S X="Requestor's "
  1.  I LA7OP(LA7OP,200,LA7OP_",",.132,"E")'="" D
  1.  . W !,?11,X,"Phone: ",LA7OP(LA7OP,200,LA7OP_",",.132,"E")
  1.  . S X=""
  1.  I LA7OP(LA7OP,200,LA7OP_",",.137,"E")'="" D
  1.  . S Y=0
  1.  . I X="" S Y=$L(LA7OP(LA7OP,200,LA7OP_",",.137,"E"))+$X+16
  1.  . I Y>IOM!(X'="") W !,?11
  1.  . E  S X="  "_X
  1.  . W X,"Voice Pager: ",LA7OP(LA7OP,200,LA7OP_",",.137,"E")
  1.  . S X=""
  1.  I LA7OP(LA7OP,200,LA7OP_",",.138,"E")'="" D
  1.  . S Y=0
  1.  . I X="" S Y=$L(LA7OP(LA7OP,200,LA7OP_",",.138,"E"))+$X+18
  1.  . I Y>IOM!(X'="") W !,?11
  1.  . E  S X="  "_X
  1.  . W X,"Digital Pager: ",LA7OP(LA7OP,200,LA7OP_",",.138,"E")
  1.  . S X=""
  1.  ;
  1.  I X="" W !
  1.  Q
  1.  ;
  1.  ;
  1. TERM ;
  1.  I 'LA7PAGE W @IOF S $X=0 Q
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="E" D ^DIR S:$D(DIRUT) LA7EXIT=1
  1.  Q
  1.  ;
  1.  ;
  1. INIT ; Initialize variables
  1.  ;
  1.  S DT=$$DT^XLFDT
  1.  S LA7QUIT=0
  1.  ;
  1.  ; Select shipping configuration
  1.  S LA7SCFG=$$SSCFG^LA7SUTL(0)
  1.  I LA7SCFG<1 S LA7QUIT=1 Q
  1.  S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
  1.  Q
  1.  ;
  1. END ;
  1.  I $E(IOST,1,2)="C-",'$G(LA7EXIT) D TERM
  1.  I $E(IOST,1,2)="P-" W @IOF S IONOFF=""
  1.  I '$D(ZTQUEUED) D ^%ZISC
  1.  ;
  1. KILL ; Cleanup variables
  1.  K %,%DT,%ZIS,A,IO("Q"),AGE,DA,DFN,DIC,DIB,DIR,DIRUT,DTOUT,DUOUT,I,J,K,LAST,PNM,SEX,SSN,X,Y,Z
  1.  K LA7AA,LA7ACC,LA7AD,LA7AN,LA7CDT,LA7CHK,LA7CMT,LA7DC,LA7END,LA7ERR,LA7EV,LA7EXIT,LA7FSITE,LA7I,LA7ICN,LA7ITEM,LA7LINE,LA7NLT,LA7NLTN,LA7NOW,LA7PAGE,LA7PROV
  1.  K LA7QUIT,LA7ROOT,LA7SBC,LA7SCFG,LA7SCOND,LA7SCONT,LA7SDT,LA7SKIP,LA7SM,LA7SMR,LA7SMST,LA7SPEC,LA7SVIA,LA7TSITE,LA7UID,LA7X
  1.  K LA760,LA762801
  1.  K LRDFN,LRDPF,LRPRAC
  1.  K ^TMP("LA7ERR",$J),^TMP("LA7SM",$J),^TMP("LA7SMRI",$J)
  1.  K ^TMP($J,"LA7SMP")  ;cmi/maw kill off temp global that stores if insurance info already printed
  1.  D KVAR^LRX
  1.  ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q