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

LA7SMPXL.m

Go to the documentation of this file. 
  1. 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
  1. EN ;
  1.  ;
  1.  N D,DIC,LA7SM,X,Y,%ZIS
  1.  ;
  1.  S DIC=69.6,DIC(0)="AQEZNM",DIC("A")="Select Shipping Manifest: ",D="D"
  1.  S DIC("S")="I $L($P(^(0),U,14))"
  1.  D MIX^DIC1 K DIC("S")
  1.  I Y<1 D END Q
  1.  ;
  1.  S LA7SMAN=$P(Y(0),U,14)
  1.  ;
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  I POP D  Q
  1.  . D HOME^%ZIS
  1.  . D END
  1.  ;
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="DQ^LA7SMPXL",ZTDESC="Shipping Manifest Reprint",ZTSAVE("LA7*")=""
  1.  . D ^%ZTLOAD,HOME^%ZIS
  1.  . D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
  1.  . D END
  1.  ;
  1. DQ ; Tasked entry point
  1.  ;
  1.  U IO
  1.  ;
  1.  S DT=$$DT^XLFDT
  1.  S LRDPF=69.6,LA7NOW=$$HTE^XLFDT($H,"1M")
  1.  S (LA7DC,LA7EXIT,LA7PAGE,LA7SCOND,LA7SCONT)=0
  1.  S LA7SCFG=0,LA7SCFG(0)=""
  1.  S LA7LINE="",$P(LA7LINE,"-",IOM)="",LA7SVIA="Electronic manifest"
  1.  ;
  1.  ; Check manifest for missing info.
  1.  S LA7CHK=0
  1.  ; Flag to print receipt.
  1.  S LA7SMR="0^0"
  1.  ; Set barcode flag
  1.  S LA7SBC=0
  1.  I IOST["P-" S LA7SBC=2
  1.  ; Shipping status flag
  1.  S LA7SMST="0^Electronic Manifest"
  1.  ;
  1.  S (LA7696,LA7QUIT)=0,LA7UID=""
  1.  S LA7SM="^"_LA7SMAN
  1.  S LA7ROOT="^LRO(69.6,""AD"",LA7SMAN)"
  1.  F LA7ITEM=1:1 S LA7ROOT=$Q(@LA7ROOT) D  Q:LA7EXIT
  1.  . I $QS(LA7ROOT,3)'=LA7SMAN S LA7EXIT=1
  1.  . I LA7EXIT Q
  1.  . I LA7UID'="",LA7UID'=$QS(LA7ROOT,4) W !,LA7LINE
  1.  . S LA7696=$QS(LA7ROOT,5)
  1.  . D SETUP
  1.  . I ($Y+12)>IOSL!('LA7PAGE) D  Q:LA7EXIT
  1.  . . I LA7PAGE W ! D WARN^LA7SMP0
  1.  . . D HED^LA7SMP0
  1.  . D SH^LA7SMP0
  1.  . I $D(LA7CMT) D CMT^LA7SMP0
  1.  . W !,?18,$E(LA7LINE,1,31)
  1.  . S LA76964=0
  1.  . F  S LA76964=$O(^LRO(69.6,LA7696,2,LA76964)) Q:LA76964<1  D
  1.  . . S LA76964(0)=$G(^LRO(69.6,LA7696,2,LA76964,0))
  1.  . . W !?18,$P(LA76964(0),"^",3),?50,$P(LA7SPEC(0),"^")
  1.  . . W !,?20,"VA NLT code [Name]: "
  1.  . . S LA7NLT=$P(LA76964(0),"^",2)
  1.  . . W $S($L(LA7NLT):LA7NLT,1:"*** None specified ***")
  1.  . . S LA7NLTN=$P(LA76964(0),"^")
  1.  . . I LA7NLTN'="" W:($X+$L($P(LA76964(0),"^",2))+3)>IOM !,?39 W " [",LA7NLTN,"]"
  1.  . . I $P(LA76964(0),"^",9)'="" W !,?20,"Host site UID: ",$P(LA76964(0),"^",9)
  1.  ;
  1.  D END
  1.  Q
  1.  ;
  1.  ;
  1. SETUP ; Setup variables for this order
  1.  ;
  1.  N I,X
  1.  ;
  1.  F I=0,1 S LA7696(I)=$G(^LRO(69.6,LA7696,I))
  1.  ;
  1.  S PNM=$P(LA7696(0),U),SEX=$P(LA7696(0),U,2),DOB=$P(LA7696(0),U,3)
  1.  S (SSN,SSN(2))=$P(LA7696(0),U,9)
  1.  ;
  1.  S LA7ACC=$P(LA7696(0),"^",12)
  1.  S LA7UID=$P(LA7696(0),"^",6)
  1.  S LA7SPEC=+$P(LA7696(0),"^",7),LA7SPEC(0)=$G(^LAB(61,LA7SPEC,0))
  1.  S LA7CDT=$P(LA7696(1),U,2)
  1.  S LA7SDT=$P(LA7696(1),U,5)
  1.  ;
  1.  ; Get collecting site and host site info
  1.  D GETSITE^LA7SMP($P(LA7696(0),U,5),DUZ(2),.LA7FSITE,.LA7TSITE)
  1.  ;
  1.  ; Ordering provider
  1.  S I=0,LA7PROV=""
  1.  F  S I=$O(^LRO(69.6,LA7696,2,I)) Q:'I  D  Q:LA7PROV'=""
  1.  . S X=$P($G(^LRO(69.6,LA7696,2,I,1)),"^")
  1.  . I X'="" S $P(LA7PROV,"^",2)=$P(X,"[")
  1.  I LA7PROV="" S LA7PROV="^REF:"_LA7FSITE(99)
  1.  ;
  1.  ; Get shipping date
  1.  S LA7SDT=$$FMTE^XLFDT($P(LA7696(1),"^",3),"")
  1.  ;
  1.  ; Check for comments
  1.  K LA7CMT
  1.  I $D(^LRO(69.6,LA7696,99,0)) D
  1.  . N DIWF,DIWL,DIWR,LA7ERR,X
  1.  . S LA7CMT=$$GET1^DIQ(69.6,LA7696_",",99,"","LA7CMT","LA7ERR(2)")
  1.  . K ^UTILITY($J,"W")
  1.  . S DIWL=1,DIWR=IOM-13,DIWF=""
  1.  . I $$GET1^DID(+$$GET1^DID(69.6,99,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
  1.  . S LA7I=$O(LA7CMT(0)),LA7CMT(LA7I)="COMMENTS: "_LA7CMT(LA7I),LA7I=0
  1.  . F  S LA7I=$O(LA7CMT(LA7I)) Q:'LA7I  S X=LA7CMT(LA7I) D ^DIWP
  1.  . K LA7CMT
  1.  . M LA7CMT=^UTILITY($J,"W",DIWL)
  1.  . K ^UTILITY($J,"W")
  1.  ;
  1.  ; Add local (host) status info
  1.  S LA7CMT=$G(LA7CMT)+1
  1.  I LA7CMT>1 S LA7CMT(LA7CMT,0)=" ",LA7CMT=LA7CMT+1
  1.  S LA7CMT(LA7CMT,0)="Host test status: "_$$GET1^DIQ(69.6,LA7696_",",6,"",,"LA7ERR(4)")
  1.  Q
  1.  ;
  1.  ;
  1. END ;
  1.  S LA7EXIT=1
  1.  D END^LA7SMP0
  1.  K LA7696,LA76964,LA7CMT,LA7SMAN
  1.  ;
  1.  Q