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