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