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

LA7SM2.m

Go to the documentation of this file. 
  1. LA7SM2 ;VA/DALOI/JMC - Shipping Manifest Options ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997;Build 9
  1.  ;
  1. REQINFO ; Enter required information prior to shipping.
  1.  D INIT^LA7SM
  1.  I LA7QUIT D CLEANUP^LA7SM Q
  1.  S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"0,1,3")
  1.  I LA7SM<0 D  Q
  1.  . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
  1.  . D CLEANUP^LA7SM
  1.  D LOCKSM^LA7SM
  1.  I LA7QUIT D  Q
  1.  . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1.  . D UNLOCKSM^LA7SM,CLEANUP^LA7SM
  1.  S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1.  F  D INFOEE Q:LA7QUIT
  1.  D UNLOCKSM^LA7SM
  1.  I LA7QUIT,$L($P(LA7QUIT,"^",2)) D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1.  E  D ASK^LA7SMP(LA7SM)
  1.  D CLEANUP^LA7SM
  1.  Q
  1.  ;
  1. INFOEE ; Required Info Enter/Edit
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7CDT,LA7I,LA7INFO,LA7J,LA7RINFO,LA7TCNT,LA7X,LA7Y,X,Y
  1.  ;
  1.  D SEL^LA7SM
  1.  I LA7QUIT Q
  1.  ;
  1.  S (LA7I,LA7TCNT)=0
  1.  F  S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I  D
  1.  . F LA7J=0,1,2 S LA7I(LA7J)=$G(^LAHM(62.8,+LA7SM,10,LA7I,LA7J))
  1.  . I $P(LA7I(0),"^",8)=0 Q  ; Previously "removed".
  1.  . I $P(LA7I(0),"^",8),$P(LA7I(0),"^",8)'=1 S LA7QUIT="1^Accession not pending shipment" Q  ; Not pending shipment
  1.  . S LA7TCNT=LA7TCNT+1
  1.  . F LA7J=1,4 I $P(LA7I(1),"^",LA7J) D
  1.  . . I '$P(LA7I(1),"^",LA7J+2) Q  ; No units specified
  1.  . . S LA7X=$S(LA7J=1:1.11,LA7J=4:1.21,1:0)
  1.  . . S LA7RINFO(LA7X)=$P(LA7I(1),"^",LA7J+1) ; Value
  1.  . . S $P(LA7RINFO(LA7X),"^",2)=$P(LA7I(1),"^",LA7J+2) ; Units
  1.  . . S LA7RINFO(LA7X,LA7I)=LA7RINFO(LA7X)_"^"_$P(LA7I(0),"^",2)
  1.  . F LA7J=1,4,8 I $P(LA7I(2),"^",LA7J) D
  1.  . . I '($S(LA7J=4:$P(LA7I(2),"^",7),1:$P(LA7I(2),"^",LA7J+2))) Q  ; No units specified.
  1.  . . S LA7X=$S(LA7J=1:2.11,LA7J=4:2.21,LA7J=8:2.31,1:0)
  1.  . . S LA7RINFO(LA7X)=$P(LA7I(2),"^",LA7J+1) ; Value
  1.  . . S $P(LA7RINFO(LA7X),"^",2)=$S(LA7J=4:$P(LA7I(2),"^",7),1:$P(LA7I(2),"^",LA7J+2)) ; Units
  1.  . . S LA7RINFO(LA7X,LA7I)=LA7RINFO(LA7X)_"^"_$P(LA7I(0),"^",2)
  1.  ;
  1.  I 'LA7TCNT,'LA7QUIT S LA7QUIT="1^Accession is not on this shipping manifest"
  1.  I '$O(LA7RINFO(0)),'LA7QUIT S LA7QUIT="1^No test needs required information for shipping"
  1.  I LA7QUIT Q
  1.  ;
  1.  S LA7CDT=+$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^")
  1.  S LA7Y=0
  1.  F  S LA7Y=$O(LA7RINFO(LA7Y)) Q:'LA7Y  D  Q:LA7QUIT
  1.  . N DA,DIR,DIRUT
  1.  . S DIR(0)="62.801,"_LA7Y
  1.  . S DIR("A")=$$GET1^DID(62.801,LA7Y,"","LABEL")
  1.  . I LA7Y=2.21 D
  1.  . . S DIR("A",1)=" "
  1.  . . S DIR("A",2)="Specimen Collection Date/time: "_$$FMTE^XLFDT(LA7CDT,"M")
  1.  . . S $P(DIR(0),"^",3)="I Y<LA7CDT!(Y>$$NOW^XLFDT) K X" ; d/t after specimen collect d/t
  1.  . I LA7Y'=2.21 D
  1.  . . N LA7X
  1.  . . S LA7X=$$GET1^DIQ(64.061,$P(LA7RINFO(LA7Y),"^",2)_",",.01) ; Units
  1.  . . S DIR("A")=DIR("A")_" (in "_LA7X_")"
  1.  . I $L($P(LA7RINFO(LA7Y),"^")) D   ; Default value
  1.  . . I LA7Y=2.21 S DIR("B")=$$FMTE^XLFDT($P(LA7RINFO(LA7Y),"^"))
  1.  . . E  S DIR("B")=$P(LA7RINFO(LA7Y),"^")
  1.  . D ^DIR
  1.  . I $D(DTOUT)!$D(DUOUT) S LA7QUIT=1 Q
  1.  . S $P(LA7INFO(LA7Y),"^")=$P(Y,"^") ; New value
  1.  I LA7QUIT Q
  1.  ;
  1.  S LA7Y=0
  1.  F  S LA7Y=$O(LA7RINFO(LA7Y)) Q:'LA7Y  D
  1.  . S LA7I=0
  1.  . F  S LA7I=$O(LA7RINFO(LA7Y,LA7I)) Q:'LA7I  D
  1.  . . I $P(LA7INFO(LA7Y),"^")=$P(LA7RINFO(LA7Y,LA7I),"^") Q  ; Value unchanged
  1.  . . N FDA,LA7628,LA768,LA7DATA
  1.  . . S LA762801=LA7I_","_+LA7SM_","
  1.  . . I LA7Y=2.21 D
  1.  . . . N LA7DURT,LA7UID,LA7UNITS,LA7X
  1.  . . . S LA7UNITS=$$GET1^DIQ(64.061,+$P(LA7RINFO(LA7Y,LA7I),"^",2)_",",.01,"E")
  1.  . . . S LA7DURT=$$FMDIFF^XLFDT(LA7INFO(LA7Y),LA7CDT,2) ; Collection duration (in seconds)
  1.  . . . I LA7UNITS="min" S LA7DURT=$FN(LA7DURT/60,"",0) ; Convert to minutes, rounded to nearest minute.
  1.  . . . I LA7UNITS="hr" S LA7DURT=$FN(LA7DURT/3600,"",0) ; Convert to hours, rounded to nearest hour.
  1.  . . . S FDA(62.8,62.801,LA762801,2.22)=LA7DURT
  1.  . . S FDA(62.8,62.801,LA762801,LA7Y)=$P(LA7INFO(LA7Y),"^") ; New value
  1.  . . D FILE^DIE("","FDA(62.8)","LA7DIE(2)") ; Update required info
  1.  . . ; Update event file
  1.  . . S LA7DATA="SM40^"_$$NOW^XLFDT_"^"_$P(LA7RINFO(LA7Y,LA7I),"^",3)_"^"_$P(LA7SM,"^",2)
  1.  . . D SEUP^LA7SMU(LA7UID,2,LA7DATA)
  1.  Q
  1.  ;
  1.  ;
  1. CHKREQI(LA7628,LA762801) ; Check for required info/incomplete setup
  1.  ; Call with LA7628 = ien of entry in file #62.8
  1.  ;         LA762801 = ien of entry in file #62.8, TEST subfile
  1.  ;
  1.  ; If errors sets LA7ERR array with error messages and TMP(LA7ERR",$J)
  1.  ;    with specific tests.
  1.  ;
  1.  N LA7FILE,LA7FLD,LA7SCFG,LA7I,LA7J
  1.  ;
  1.  S LA7ERR=$G(LA7ERR,0)
  1.  S LA7628(0)=$G(^LAHM(62.8,LA7628,0))
  1.  S LA7SCFG=$P(LA7628(0),"^",2)
  1.  S LA7SCFG(0)=$G(^LAHM(62.9,LA7SCFG,0))
  1.  ;
  1.  F LA7J=0,1,2,5 S LA7I(LA7J)=$G(^LAHM(62.8,LA7628,10,LA762801,LA7J))
  1.  ;
  1.  S LA7FILE=62.801
  1.  ;
  1.  I $P(LA7I(1),"^") D
  1.  . F LA7J=2,3,7 I '$L($P(LA7I(1),"^",LA7J)) S LA7FLD=$S(LA7J=2:1.11,LA7J=3:1.13,1:1.14) D SETERR
  1.  ;
  1.  I $P(LA7I(1),"^",4) D
  1.  . F LA7J=5,6,8 I '$L($P(LA7I(1),"^",LA7J)) S LA7FLD=$S(LA7J=5:1.21,LA7J=6:1.23,1:1.24) D SETERR
  1.  ;
  1.  I $P(LA7I(2),"^") D
  1.  . F LA7J=2,3,11 I '$L($P(LA7I(2),"^",LA7J)) S LA7FLD=$S(LA7J=2:2.11,LA7J=3:2.13,1:2.14) D SETERR
  1.  ;
  1.  I $P(LA7I(2),"^",4) D
  1.  . F LA7J=5,6,7,12 I '$L($P(LA7I(2),"^",LA7J)) S LA7FLD=$S(LA7J=5:2.21,LA7J=6:2.22,LA7J=7:2.23,1:2.24) D SETERR
  1.  ;
  1.  I $P(LA7I(2),"^",8) D
  1.  . F LA7J=9,10,13 I '$L($P(LA7I(2),"^",LA7J)) S LA7FLD=$S(LA7J=9:2.31,LA7J=10:2.33,1:2.34) D SETERR
  1.  ;
  1.  ; Check if using non-VA codes
  1.  I $P(LA7628(0),"^",5) D
  1.  . F LA7J=1,2 I '$L($P(LA7I(5),"^",LA7J)) S LA7FLD=$S(LA7J=1:5.1,1:5.2) D SETERR
  1.  ;I '$$GET1^DIQ(60,+$P(LA7I(0),"^",2)_",",64,"I") S LA7FILE=60,LA7FLD=64 D SETERR  ihs/cmi/maw 11/17/2010 don't throw error if non va code
  1.  I 'LA7ERR,$O(LA7ERR(""))'="" S LA7ERR=1
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SETERR ; Set error log for entries missing values in 62.8
  1.  ; Called from above.
  1.  ;
  1.  S LA7ERR(LA7FILE_":"_LA7FLD)="Missing Required Info - "_$$GET1^DID(LA7FILE,LA7FLD,"","LABEL")
  1.  S ^TMP("LA7ERR",$J,LA7FILE_":"_LA7FLD,LA7628,$P(LA7I(0),"^",5),$P(LA7I(0),"^",2))=""
  1.  Q
  1.  ;
  1.  ;
  1. BUILDRI ; Build global with required info to print on manifest.
  1.  ; Called from LA7SMP
  1.  ;
  1.  N LA7I,LA7X
  1.  ;
  1.  ; No required info
  1.  I $G(LA762801(1))="",$G(LA762801(2))="" Q
  1.  ;
  1.  F LA7I=1,2 S LA7X(LA7I)=$G(^TMP("LA7SMRI",$J,+$P(LA762801(0),"^",7),+$P(LA762801(0),"^",9),$P(LA762801(0),"^",5),LA7I))
  1.  ;
  1.  ; Check for patient required info.
  1.  F LA7I=1,4 I $P($G(LA762801(1)),"^",LA7I) D
  1.  . S $P(LA7X(1),"^",LA7I)=$P(LA762801(1),"^",LA7I)
  1.  . I LA7I=1 S $P(LA7X(1),"^",2,3)=$P(LA762801(1),"^",2,3) Q
  1.  . I LA7I=4 S $P(LA7X(1),"^",5,6)=$P(LA762801(1),"^",5,6) Q
  1.  ;
  1.  ; Check for specimen required info.
  1.  F LA7I=1,4,8 I $P($G(LA762801(2)),"^",LA7I) D
  1.  . S $P(LA7X(2),"^",LA7I)=$P(LA762801(2),"^",LA7I)
  1.  . I LA7I=1 S $P(LA7X(2),"^",2,3)=$P(LA762801(2),"^",2,3) Q
  1.  . I LA7I=4 S $P(LA7X(2),"^",5,7)=$P(LA762801(2),"^",5,7) Q
  1.  . I LA7I=8 S $P(LA7X(2),"^",9,10)=$P(LA762801(2),"^",9,10) Q
  1.  ;
  1.  ; Store required info for printing
  1.  F LA7I=1,2 I $L($G(LA7X(LA7I))) S ^TMP("LA7SMRI",$J,+$P(LA762801(0),"^",7),+$P(LA762801(0),"^",9),$P(LA762801(0),"^",5),LA7I)=LA7X(LA7I)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. RCI ; Enter/edit relevant clinical information
  1.  N DA,FDA,LA7628,LA762801,LA7DIR,LA7QUIT,LA7TCNT,LA7Y
  1.  D INIT^LA7SM
  1.  I LA7QUIT D CLEANUP^LA7SM Q
  1.  S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"0,1,3")
  1.  I LA7SM<0 D  Q
  1.  . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
  1.  . D CLEANUP^LA7SM
  1.  D LOCKSM^LA7SM
  1.  I LA7QUIT D  Q
  1.  . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1.  . D UNLOCKSM^LA7SM,CLEANUP^LA7SM
  1.  S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1.  D SEL^LA7SM
  1.  I LA7QUIT D UNLOCKSM^LA7SM,CLEANUP^LA7SM Q
  1.  S (LA7I,LA7TCNT)=0
  1.  F  S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I  D
  1.  . S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
  1.  . I $P(LA7I(0),"^",8)=0 Q  ; Previously "removed".
  1.  . I $P(LA7I(0),"^",8),$P(LA7I(0),"^",8)'=1 S LA7QUIT="1^Accession not pending shipment" Q
  1.  . S LA7TCNT=LA7TCNT+1,LA760(LA7TCNT)=LA7I_"^"_LA7I(0)
  1.  I 'LA7TCNT,'LA7QUIT S LA7QUIT="1^Accession is not on this shipping manifest"
  1.  I LA7QUIT D UNLOCKSM^LA7SM,CLEANUP^LA7SM Q
  1.  S LA7I=0
  1.  F  S LA7I=$O(LA760(LA7I)) Q:'LA7I  D EN^DDIOL(LA7I_" "_$P($G(^LAB(60,+$P(LA760(LA7I),"^",3),0)),"^"),"","!?5")
  1.  S DIR(0)="LO^1:"_LA7TCNT,DIR("A")="Select test(s) to edit clinical info"
  1.  D ^DIR
  1.  I $D(DIRUT) S LA7QUIT=1 D UNLOCKSM^LA7SM,CLEANUP^LA7SM Q
  1.  M LA7YARRY=Y
  1.  K DIR
  1.  D FIELD^DID(62.801,.1,,"DESCRIPTION;FIELD LENGTH;HELP-PROMPT","LA7DIR")
  1.  S LA7X=$P($G(^LAHM(62.9,+$P(LA7SM(0),"^",2),0)),"^",3)
  1.  I $$NVAF^LA7VHLU2(LA7X)=1 D
  1.  . S LA7DIR("FIELD LENGTH")=78
  1.  . S LA7DIR("HELP-PROMPT")="Answer must be 1-78 characters in length."
  1.  S DIR(0)="FAO^1:"_LA7DIR("FIELD LENGTH"),DIR("A")="Relevant clinical information: "
  1.  M DIR("?")=LA7DIR("DESCRIPTION"),DIR("?")=LA7DIR("HELP-PROMPT")
  1.  S LA7Y="",LA7628=+LA7SM,LA7QUIT=0
  1.  F  S LA7Y=$O(LA7YARRY(LA7Y)) Q:LA7Y=""  D  Q:LA7QUIT
  1.  . F LA7I=1:1 Q:'$P(LA7YARRY(LA7Y),",",LA7I)  D  Q:LA7QUIT
  1.  . . K DA,DIRUT,DUOUT,DTOUT,FDA,LA7DIE
  1.  . . S LA7X=$P(LA7YARRY(LA7Y),",",LA7I),DA=+LA760(LA7X)
  1.  . . S LA762801=DA_","_LA7628_","
  1.  . . W !,"For test: ",$$GET1^DIQ(62.801,LA762801,.02)
  1.  . . S DIR("B")=$$GET1^DIQ(62.801,LA762801,.1)
  1.  . . I DIR("B")="" K DIR("B")
  1.  . . D ^DIR
  1.  . . I $D(DIRUT),X'="@" S LA7QUIT=1 Q
  1.  . . I Y="",X="@" S Y="@"
  1.  . . S FDA(62.8,62.801,LA762801,.1)=Y
  1.  . . D FILE^DIE("","FDA(62.8)","LA7DIE(1)")
  1.  ;
  1.  D UNLOCKSM^LA7SM,CLEANUP^LA7SM
  1.  Q