LA7SMPXL ;VA/DALOI/JMC - PRINT SHIPPING MANIFEST FROM PENDING ORDERS FILE ;JUL 06, 2010 3:14 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,42,46,64,1027**;NOV 01, 1997
EN ;
;
N D,DIC,LA7SM,X,Y,%ZIS
;
S DIC=69.6,DIC(0)="AQEZNM",DIC("A")="Select Shipping Manifest: ",D="D"
S DIC("S")="I $L($P(^(0),U,14))"
D MIX^DIC1 K DIC("S")
I Y<1 D END Q
;
S LA7SMAN=$P(Y(0),U,14)
;
S %ZIS="MQ"
D ^%ZIS
I POP D Q
. D HOME^%ZIS
. D END
;
I $D(IO("Q")) D Q
. S ZTRTN="DQ^LA7SMPXL",ZTDESC="Shipping Manifest Reprint",ZTSAVE("LA7*")=""
. D ^%ZTLOAD,HOME^%ZIS
. D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
. D END
;
DQ ; Tasked entry point
;
U IO
;
S DT=$$DT^XLFDT
S LRDPF=69.6,LA7NOW=$$HTE^XLFDT($H,"1M")
S (LA7DC,LA7EXIT,LA7PAGE,LA7SCOND,LA7SCONT)=0
S LA7SCFG=0,LA7SCFG(0)=""
S LA7LINE="",$P(LA7LINE,"-",IOM)="",LA7SVIA="Electronic manifest"
;
; Check manifest for missing info.
S LA7CHK=0
; Flag to print receipt.
S LA7SMR="0^0"
; Set barcode flag
S LA7SBC=0
I IOST["P-" S LA7SBC=2
; Shipping status flag
S LA7SMST="0^Electronic Manifest"
;
S (LA7696,LA7QUIT)=0,LA7UID=""
S LA7SM="^"_LA7SMAN
S LA7ROOT="^LRO(69.6,""AD"",LA7SMAN)"
F LA7ITEM=1:1 S LA7ROOT=$Q(@LA7ROOT) D Q:LA7EXIT
. I $QS(LA7ROOT,3)'=LA7SMAN S LA7EXIT=1
. I LA7EXIT Q
. I LA7UID'="",LA7UID'=$QS(LA7ROOT,4) W !,LA7LINE
. S LA7696=$QS(LA7ROOT,5)
. D SETUP
. I ($Y+12)>IOSL!('LA7PAGE) D Q:LA7EXIT
. . I LA7PAGE W ! D WARN^LA7SMP0
. . D HED^LA7SMP0
. D SH^LA7SMP0
. I $D(LA7CMT) D CMT^LA7SMP0
. W !,?18,$E(LA7LINE,1,31)
. S LA76964=0
. F S LA76964=$O(^LRO(69.6,LA7696,2,LA76964)) Q:LA76964<1 D
. . S LA76964(0)=$G(^LRO(69.6,LA7696,2,LA76964,0))
. . W !?18,$P(LA76964(0),"^",3),?50,$P(LA7SPEC(0),"^")
. . W !,?20,"VA NLT code [Name]: "
. . S LA7NLT=$P(LA76964(0),"^",2)
. . W $S($L(LA7NLT):LA7NLT,1:"*** None specified ***")
. . S LA7NLTN=$P(LA76964(0),"^")
. . I LA7NLTN'="" W:($X+$L($P(LA76964(0),"^",2))+3)>IOM !,?39 W " [",LA7NLTN,"]"
. . I $P(LA76964(0),"^",9)'="" W !,?20,"Host site UID: ",$P(LA76964(0),"^",9)
;
D END
Q
;
;
SETUP ; Setup variables for this order
;
N I,X
;
F I=0,1 S LA7696(I)=$G(^LRO(69.6,LA7696,I))
;
S PNM=$P(LA7696(0),U),SEX=$P(LA7696(0),U,2),DOB=$P(LA7696(0),U,3)
S (SSN,SSN(2))=$P(LA7696(0),U,9)
;
S LA7ACC=$P(LA7696(0),"^",12)
S LA7UID=$P(LA7696(0),"^",6)
S LA7SPEC=+$P(LA7696(0),"^",7),LA7SPEC(0)=$G(^LAB(61,LA7SPEC,0))
S LA7CDT=$P(LA7696(1),U,2)
S LA7SDT=$P(LA7696(1),U,5)
;
; Get collecting site and host site info
D GETSITE^LA7SMP($P(LA7696(0),U,5),DUZ(2),.LA7FSITE,.LA7TSITE)
;
; Ordering provider
S I=0,LA7PROV=""
F S I=$O(^LRO(69.6,LA7696,2,I)) Q:'I D Q:LA7PROV'=""
. S X=$P($G(^LRO(69.6,LA7696,2,I,1)),"^")
. I X'="" S $P(LA7PROV,"^",2)=$P(X,"[")
I LA7PROV="" S LA7PROV="^REF:"_LA7FSITE(99)
;
; Get shipping date
S LA7SDT=$$FMTE^XLFDT($P(LA7696(1),"^",3),"")
;
; Check for comments
K LA7CMT
I $D(^LRO(69.6,LA7696,99,0)) D
. N DIWF,DIWL,DIWR,LA7ERR,X
. S LA7CMT=$$GET1^DIQ(69.6,LA7696_",",99,"","LA7CMT","LA7ERR(2)")
. K ^UTILITY($J,"W")
. S DIWL=1,DIWR=IOM-13,DIWF=""
. I $$GET1^DID(+$$GET1^DID(69.6,99,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
. S LA7I=$O(LA7CMT(0)),LA7CMT(LA7I)="COMMENTS: "_LA7CMT(LA7I),LA7I=0
. F S LA7I=$O(LA7CMT(LA7I)) Q:'LA7I S X=LA7CMT(LA7I) D ^DIWP
. K LA7CMT
. M LA7CMT=^UTILITY($J,"W",DIWL)
. K ^UTILITY($J,"W")
;
; Add local (host) status info
S LA7CMT=$G(LA7CMT)+1
I LA7CMT>1 S LA7CMT(LA7CMT,0)=" ",LA7CMT=LA7CMT+1
S LA7CMT(LA7CMT,0)="Host test status: "_$$GET1^DIQ(69.6,LA7696_",",6,"",,"LA7ERR(4)")
Q
;
;
END ;
S LA7EXIT=1
D END^LA7SMP0
K LA7696,LA76964,LA7CMT,LA7SMAN
;
Q
LA7SMPXL ;VA/DALOI/JMC - PRINT SHIPPING MANIFEST FROM PENDING ORDERS FILE ;JUL 06, 2010 3:14 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,42,46,64,1027**;NOV 01, 1997
EN ;
+1 ;
+2 NEW D,DIC,LA7SM,X,Y,%ZIS
+3 ;
+4 SET DIC=69.6
SET DIC(0)="AQEZNM"
SET DIC("A")="Select Shipping Manifest: "
SET D="D"
+5 SET DIC("S")="I $L($P(^(0),U,14))"
+6 DO MIX^DIC1
KILL DIC("S")
+7 IF Y<1
DO END
QUIT
+8 ;
+9 SET LA7SMAN=$PIECE(Y(0),U,14)
+10 ;
+11 SET %ZIS="MQ"
+12 DO ^%ZIS
+13 IF POP
Begin DoDot:1
+14 DO HOME^%ZIS
+15 DO END
End DoDot:1
QUIT
+16 ;
+17 IF $DATA(IO("Q"))
Begin DoDot:1
+18 SET ZTRTN="DQ^LA7SMPXL"
SET ZTDESC="Shipping Manifest Reprint"
SET ZTSAVE("LA7*")=""
+19 DO ^%ZTLOAD
DO HOME^%ZIS
+20 DO EN^DDIOL("Request "_$SELECT($GET(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
+21 DO END
End DoDot:1
QUIT
+22 ;
DQ ; Tasked entry point
+1 ;
+2 USE IO
+3 ;
+4 SET DT=$$DT^XLFDT
+5 SET LRDPF=69.6
SET LA7NOW=$$HTE^XLFDT($HOROLOG,"1M")
+6 SET (LA7DC,LA7EXIT,LA7PAGE,LA7SCOND,LA7SCONT)=0
+7 SET LA7SCFG=0
SET LA7SCFG(0)=""
+8 SET LA7LINE=""
SET $PIECE(LA7LINE,"-",IOM)=""
SET LA7SVIA="Electronic manifest"
+9 ;
+10 ; Check manifest for missing info.
+11 SET LA7CHK=0
+12 ; Flag to print receipt.
+13 SET LA7SMR="0^0"
+14 ; Set barcode flag
+15 SET LA7SBC=0
+16 IF IOST["P-"
SET LA7SBC=2
+17 ; Shipping status flag
+18 SET LA7SMST="0^Electronic Manifest"
+19 ;
+20 SET (LA7696,LA7QUIT)=0
SET LA7UID=""
+21 SET LA7SM="^"_LA7SMAN
+22 SET LA7ROOT="^LRO(69.6,""AD"",LA7SMAN)"
+23 FOR LA7ITEM=1:1
SET LA7ROOT=$QUERY(@LA7ROOT)
Begin DoDot:1
+24 IF $QSUBSCRIPT(LA7ROOT,3)'=LA7SMAN
SET LA7EXIT=1
+25 IF LA7EXIT
QUIT
+26 IF LA7UID'=""
IF LA7UID'=$QSUBSCRIPT(LA7ROOT,4)
WRITE !,LA7LINE
+27 SET LA7696=$QSUBSCRIPT(LA7ROOT,5)
+28 DO SETUP
+29 IF ($Y+12)>IOSL!('LA7PAGE)
Begin DoDot:2
+30 IF LA7PAGE
WRITE !
DO WARN^LA7SMP0
+31 DO HED^LA7SMP0
End DoDot:2
IF LA7EXIT
QUIT
+32 DO SH^LA7SMP0
+33 IF $DATA(LA7CMT)
DO CMT^LA7SMP0
+34 WRITE !,?18,$EXTRACT(LA7LINE,1,31)
+35 SET LA76964=0
+36 FOR
SET LA76964=$ORDER(^LRO(69.6,LA7696,2,LA76964))
IF LA76964<1
QUIT
Begin DoDot:2
+37 SET LA76964(0)=$GET(^LRO(69.6,LA7696,2,LA76964,0))
+38 WRITE !?18,$PIECE(LA76964(0),"^",3),?50,$PIECE(LA7SPEC(0),"^")
+39 WRITE !,?20,"VA NLT code [Name]: "
+40 SET LA7NLT=$PIECE(LA76964(0),"^",2)
+41 WRITE $SELECT($LENGTH(LA7NLT):LA7NLT,1:"*** None specified ***")
+42 SET LA7NLTN=$PIECE(LA76964(0),"^")
+43 IF LA7NLTN'=""
IF ($X+$LENGTH($PIECE(LA76964(0),"^",2))+3)>IOM
WRITE !,?39
WRITE " [",LA7NLTN,"]"
+44 IF $PIECE(LA76964(0),"^",9)'=""
WRITE !,?20,"Host site UID: ",$PIECE(LA76964(0),"^",9)
End DoDot:2
End DoDot:1
IF LA7EXIT
QUIT
+45 ;
+46 DO END
+47 QUIT
+48 ;
+49 ;
SETUP ; Setup variables for this order
+1 ;
+2 NEW I,X
+3 ;
+4 FOR I=0,1
SET LA7696(I)=$GET(^LRO(69.6,LA7696,I))
+5 ;
+6 SET PNM=$PIECE(LA7696(0),U)
SET SEX=$PIECE(LA7696(0),U,2)
SET DOB=$PIECE(LA7696(0),U,3)
+7 SET (SSN,SSN(2))=$PIECE(LA7696(0),U,9)
+8 ;
+9 SET LA7ACC=$PIECE(LA7696(0),"^",12)
+10 SET LA7UID=$PIECE(LA7696(0),"^",6)
+11 SET LA7SPEC=+$PIECE(LA7696(0),"^",7)
SET LA7SPEC(0)=$GET(^LAB(61,LA7SPEC,0))
+12 SET LA7CDT=$PIECE(LA7696(1),U,2)
+13 SET LA7SDT=$PIECE(LA7696(1),U,5)
+14 ;
+15 ; Get collecting site and host site info
+16 DO GETSITE^LA7SMP($PIECE(LA7696(0),U,5),DUZ(2),.LA7FSITE,.LA7TSITE)
+17 ;
+18 ; Ordering provider
+19 SET I=0
SET LA7PROV=""
+20 FOR
SET I=$ORDER(^LRO(69.6,LA7696,2,I))
IF 'I
QUIT
Begin DoDot:1
+21 SET X=$PIECE($GET(^LRO(69.6,LA7696,2,I,1)),"^")
+22 IF X'=""
SET $PIECE(LA7PROV,"^",2)=$PIECE(X,"[")
End DoDot:1
IF LA7PROV'=""
QUIT
+23 IF LA7PROV=""
SET LA7PROV="^REF:"_LA7FSITE(99)
+24 ;
+25 ; Get shipping date
+26 SET LA7SDT=$$FMTE^XLFDT($PIECE(LA7696(1),"^",3),"")
+27 ;
+28 ; Check for comments
+29 KILL LA7CMT
+30 IF $DATA(^LRO(69.6,LA7696,99,0))
Begin DoDot:1
+31 NEW DIWF,DIWL,DIWR,LA7ERR,X
+32 SET LA7CMT=$$GET1^DIQ(69.6,LA7696_",",99,"","LA7CMT","LA7ERR(2)")
+33 KILL ^UTILITY($JOB,"W")
+34 SET DIWL=1
SET DIWR=IOM-13
SET DIWF=""
+35 IF $$GET1^DID(+$$GET1^DID(69.6,99,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L"
SET DIWF="N"
+36 SET LA7I=$ORDER(LA7CMT(0))
SET LA7CMT(LA7I)="COMMENTS: "_LA7CMT(LA7I)
SET LA7I=0
+37 FOR
SET LA7I=$ORDER(LA7CMT(LA7I))
IF 'LA7I
QUIT
SET X=LA7CMT(LA7I)
DO ^DIWP
+38 KILL LA7CMT
+39 MERGE LA7CMT=^UTILITY($JOB,"W",DIWL)
+40 KILL ^UTILITY($JOB,"W")
End DoDot:1
+41 ;
+42 ; Add local (host) status info
+43 SET LA7CMT=$GET(LA7CMT)+1
+44 IF LA7CMT>1
SET LA7CMT(LA7CMT,0)=" "
SET LA7CMT=LA7CMT+1
+45 SET LA7CMT(LA7CMT,0)="Host test status: "_$$GET1^DIQ(69.6,LA7696_",",6,"",,"LA7ERR(4)")
+46 QUIT
+47 ;
+48 ;
END ;
+1 SET LA7EXIT=1
+2 DO END^LA7SMP0
+3 KILL LA7696,LA76964,LA7CMT,LA7SMAN
+4 ;
+5 QUIT
