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

LA7PCFG.m

Go to the documentation of this file. 
  1. LA7PCFG ;VA/DALOI/JMC - Configrure Lab Point of Care Interface; Jan 12, 2004
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LA Patche(s): 67
  1.  ;
  1.  ; Reference to DIV4^XUSER supported by DBIA #2533
  1.  Q
  1.  ;
  1. EN ; Configure files #62.48, #62.4 and #68.2
  1.  N DIR,DIROUT,DIRUT,DUOUT,LA7QUIT,LRLL,X,Y
  1.  S LRLL=0
  1.  F  D  Q:$D(DIRUT)
  1.  . S DIR(0)="SO^1:LA7 MESSAGE PARAMETER (#62.48);2:LOAD/WORK LIST (#68.2);3:AUTO INSTRUMENT (#62.4);4:Print POC Test Code Mapping"
  1.  . S DIR("A")="Select which file to setup"
  1.  . D ^DIR
  1.  . I $D(DIRUT) Q
  1.  . I Y=1 D E6248 Q
  1.  . I Y=2 D E682 Q
  1.  . I Y=3 D E624 Q
  1.  . I Y=4 D PRINT Q
  1.  Q
  1.  ;
  1.  ;
  1. E6248 ; Setup/edit file #62.48
  1.  ;
  1.  N DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,DUOUT,LA76248,LA7TYP,X,Y
  1.  D EN^DDIOL("","","!!")
  1.  S DIC="^LAHM(62.48,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,9)=20!($P(^(0),U,9)=21)"
  1.  D ^DIC
  1.  I Y<1 Q
  1.  S (DA,LA76248)=+Y
  1.  L +^LAHM(62.48,LA76248):0
  1.  I '$T D EN^DDIOL("Another user is editing this entry.","","!?5") Q
  1.  D EN^DDIOL("","","!!")
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Does this POC interface want to receive VistA ADT messages"
  1.  S DIR("B")=$S($P($G(^LAHM(62.48,LA76248,0)),"^",9)=21:"YES",1:"NO")
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S LA7TYP=$S(Y=1:21,1:20)
  1.  I LA7TYP=21 D
  1.  . D EN^DDIOL("Remember to add the LA7POC ADT RTR event protocol to the appropriate","","!!")
  1.  . D EN^DDIOL("ADT event protocols as specified in the Lab POC User Guide","","!")
  1.  . D EN^DDIOL("","","!!")
  1.  S DIE=DIC,DR="11///"_LA7TYP_";2;3;4///ON;20"
  1.  D ^DIE
  1.  L -^LAHM(62.48,LA76248)
  1.  Q
  1.  ;
  1.  ;
  1. E624 ; Setup/edit file #62.4
  1.  ;
  1.  N DA,DIC,DIE,DR,LA7624,LA76248,LA7ERR,LRNLT,LRX,LRY,X,Y
  1.  ;
  1.  D EN^DDIOL("","","!")
  1.  S DIC="^LAB(62.4,",DIC(0)="AEMQ",DIC("S")="I $E($P(^(0),U),1,6)=""LA7POC"""
  1.  D ^DIC
  1.  I Y<1 Q
  1.  S (DA,LA7624)=+Y
  1.  L +^LAB(62.4,LA7624):0
  1.  I '$T D EN^DDIOL("Another user is editing this entry.","","!?5") Q
  1.  S DIE=DIC
  1.  S DR="3"_$S(LRLL>0:"//"_$$GET1^DIQ(68.2,LRLL_",",.01),1:"")_";8;10;11;12////0;18;30;107"
  1.  S DR(2,62.41)=".01;S LRNLT=$$GET1^DIQ(64,+$P($G(^LAB(60,X,64)),U,2)_"","",1);2;6////^S X=LRNLT;8R;12;13;14;17;18;19;21//YES"
  1.  D ^DIE
  1.  ;
  1.  ; Check if loadlist type = POC
  1.  I $P(^LAB(62.4,LA7624,0),"^",4) D
  1.  . S LRLL=$P(^LAB(62.4,LA7624,0),"^",4)
  1.  . I $P(^LRO(68.2,LRLL,0),"^",3)'=2 D EN^DDIOL("**WARNING-Associated Load/Work List "_$$GET1^DIQ(68.2,LRLL_",",.01)_" is not TYPE: POINT OF CARE**","","!?2")
  1.  ;
  1.  ; Check if 62.4 name matches 62.48 name
  1.  I $P(^LAB(62.4,LA7624,0),"^",8) D
  1.  . S LRX=$$GET1^DIQ(62.48,$P(^LAB(62.4,LA7624,0),"^",8)_",",.01)
  1.  . S LRY=$$GET1^DIQ(62.4,LA7624_",",.01)
  1.  . I LRX'=LRY D EN^DDIOL("**WARNING-Name of entry in AUTO INSTRUMENT file should match name of MESSAGE CONFIGURATION**","","!?2")
  1.  ;
  1.  L -^LAB(62.4,LA7624)
  1.  Q
  1.  ;
  1.  ;
  1. E682 ; Setup/edit file #68.2
  1.  N DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DUOUT,I
  1.  N LA7ERR,LR60,LR61,LRAA,LRDIV,LRMSG,LRPROF,LRX,LRY,X,Y
  1.  ;
  1.  D EN^DDIOL("","","!")
  1.  S DIC="^LRO(68.2,",DIC(0)="AELMQ"
  1.  I LRLL>0 S DIC("B")=$$GET1^DIQ(68.2,LRLL_",",.01)
  1.  D ^DIC
  1.  I Y<1 Q
  1.  S (DA,LRLL)=+Y
  1.  L +^LRO(68.2,LRLL):0
  1.  I '$T D EN^DDIOL("Another user is editing this entry.","","!?5") Q
  1.  S DIE=DIC
  1.  S DR=".01;.02///UNIVERSAL;.03///2;.08///ACCESSION;.14;1;1.5;1.7;50"
  1.  S DR(2,68.23)=".01;2;2.2;1"
  1.  S DR(3,68.24)=".01;I ""IB""'[$P(^LAB(60,X,0),""^"",3) S Y=2;1R;3;4;2///NO"
  1.  D ^DIE
  1.  L -^LRO(68.2,LRLL)
  1.  W !
  1.  ;
  1.  S LRPROF=$O(^LRO(68.2,LRLL,10,0))
  1.  I LRPROF<1 D  Q
  1.  . D EN^DDIOL($C(7)_"*** Need at least one profile for POC interface ***","","!!")
  1.  ;
  1.  I $O(^LRO(68.2,LRLL,10,LRPROF)) D  Q
  1.  . D EN^DDIOL($C(7)_"*** Only one profile should exist for POC interface ***","","!!")
  1.  ;
  1.  S LRAA=$P($G(^LRO(68.2,LRLL,10,LRPROF,0)),U,2)
  1.  I 'LRAA Q
  1.  ;
  1.  ; Check tests on profile for specimen/collection sample
  1.  S I=0
  1.  F  S I=$O(^LRO(68.2,LRLL,10,LRPROF,1,I)) Q:'I  D
  1.  . S LRX=$G(^LRO(68.2,LRLL,10,LRPROF,1,I,0))
  1.  . S LR60=$P(LRX,"^"),LR61=$P(LRX,"^",2)
  1.  . S LR60(0)=^LAB(60,LR60,0)
  1.  . I "IB"[$P(LR60(0),"^",3) D
  1.  . . I 'LR61 D  Q
  1.  . . . S LRMSG(I)=$P(LR60(0),"^")_" missing specimen"
  1.  . . I '$P(LRX,"^",5) D
  1.  . . . S LRMSG(I)=$P(LR60(0),"^")_" missing collection sample for specimen "_$P(^LAB(61,LR61,0),"^")
  1.  I $D(LRMSG) D EN^DDIOL(.LRMSG,"","")
  1.  ;
  1.  D EN^DDIOL("Now edit the associated division for accession area "_$$GET1^DIQ(68,LRAA_",",.01)_".","","!!")
  1.  S DA=LRAA,DIE="^LRO(68,",DR=".091"
  1.  D ^DIE
  1.  ;
  1.  S LRDIV=$O(^LRO(68,LRAA,3,0))
  1.  I 'LRDIV D  Q
  1.  . D EN^DDIOL("*** A division needs to be associated with this POC accession area ***","","!!")
  1.  ;
  1.  I $O(^LRO(68,LRAA,3,LRDIV)) D
  1.  . D EN^DDIOL($C(7)_"*** Lab POC software will use "_$P($$NS^XUAF4(LRDIV),"^"),"","!!")
  1.  . D EN^DDIOL("as the default division with this accession area ***","","!?4")
  1.  ;
  1.  S LRX=$$FIND1^DIC(200,"","OX","LRLAB,POC","B","")
  1.  I LRX<1 D EN^DDIOL($C(7)_"*** Unable to identify user 'LRLAB,POC' in NEW PERSON file ***","","!!")
  1.  I LRX>0 D
  1.  . K LRY
  1.  . S LRY=$$DIV4^XUSER(.LRY,LRX)
  1.  . I $D(LRY(LRDIV)) Q
  1.  . D EN^DDIOL($C(7)_"*** Have IRM assign division "_$P($$NS^XUAF4(LRDIV),"^")_" to user 'LRLAB,POC' ***","","!!")
  1.  Q
  1.  ;
  1.  ;
  1. PRINT ; Print test code mappings for POC setup
  1.  N %ZIS,DIC,LA7624,ZTDTH,ZTSK,ZTRTN,ZTIO,ZTSAVE,X,Y
  1.  ;
  1.  D EN^DDIOL("","","!")
  1.  S DIC="^LAB(62.4,",DIC(0)="AEMQ",DIC("S")="I $E($P(^(0),U),1,6)=""LA7POC"""
  1.  D ^DIC
  1.  I Y<1 Q
  1.  S LA7624=+Y
  1.  ;
  1.  S %ZIS="MQ" D ^%ZIS
  1.  I POP D HOME^%ZIS Q
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="DQP^LA7PCFG",ZTSAVE("LA7624")="",ZTDESC="Print POC Setup"
  1.  . D ^%ZTLOAD,^%ZISC
  1.  . D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
  1.  ;
  1. DQP ; entry point from above and TaskMan
  1.  ;
  1.  N I,X,Y
  1.  N LA7EXIT,LA7INTYP,LA7LINE,LA7LINE2,LA7NOW,LA7PAGE,LA7CODE
  1.  N LA76248,LR60,LR61,LR62,LR64,LR642,LRLL,LRPROF
  1.  S LA7NOW=$$HTE^XLFDT($H,"1D"),(LA7EXIT,LA7PAGE)=0
  1.  S LA7624(0)=$G(^LAB(62.4,LA7624,0))
  1.  S LA76248=$P(LA7624(0),"^",8)
  1.  S LA7INTYP=$P(^LAHM(62.48,LA76248,0),"^",9)
  1.  S LRLL=$P(LA7624(0),"^",4)
  1.  S LRPROF=$O(^LRO(68.2,LRLL,10,0))
  1.  S LA7LINE=$$REPEAT^XLFSTR("=",IOM)
  1.  S LA7LINE2=$$REPEAT^XLFSTR("-",IOM)
  1.  D HDR
  1.  W !!,"VistA ADT feed enabled: ",$S(LA7INTYP=21:"YES",LA7INTYP=20:"NO",1:"UNKNOWN"),!!
  1.  D SH1
  1.  ;
  1.  S I=0
  1.  F  S I=$O(^LRO(68.2,LRLL,10,LRPROF,1,I)) Q:'I  D  Q:LA7EXIT
  1.  . I ($Y+6)>IOSL D HDR Q:LA7EXIT  D SH1 Q:LA7EXIT
  1.  . S X=^LRO(68.2,LRLL,10,LRPROF,1,I,0)
  1.  . S LR60=+X,LR64=+$G(^LAB(60,LR60,64)),LR64(0)=$G(^LAM(LR64,0))
  1.  . S LR61=$P(X,"^",2),LR642=$P(X,"^",4),LR62=0
  1.  . I LR61 S LR62=$P(X,"^",5)
  1.  . I 'LR62,LR61 S LR62=$$GET1^DIQ(61,LR61_",",4.1,"I")
  1.  . W !,$J(I,2),?3,$E($P(^LAB(60,LR60,0),"^"),1,25)
  1.  . S X=$P(LR64(0),"^",2)
  1.  . W ?30,$S(X'="":X,1:"<Missing>")
  1.  . I LR61 D
  1.  . . S X="("_LR61_")"
  1.  . . S X=$E($P(^LAB(61,LR61,0),"^"),1,19-$L(X))_X
  1.  . E  S X="<Missing>"
  1.  . W ?50,X
  1.  . S X=$S(LR61:$E($$GET1^DIQ(61,LR61_",","LEDI HL7:HL7 ABBR"),1,14),1:" ")
  1.  . W ?70,$S(X'="":X,1:"<Missing>")
  1.  . W !,?30,$P(LR64(0),"^")
  1.  . W ?50,$S(LR62:$P(^LAB(62,LR62,0),"^"),'LR61:"",1:"<Missing>")
  1.  . S X=$S(LR642:$P($G(^LAB(64.2,LR642,0)),"^",2),1:"")
  1.  . W ?70,$S(X'="":X,1:"No Mapping"),!
  1.  . I LR64<1 W ?3,"Warning - test does not have NATIONAL VA LAB CODE assigned.",!
  1.  ;
  1.  I LA7EXIT D CLEAN Q
  1.  I ($Y+6)>IOSL D HDR
  1.  I LA7EXIT D CLEAN Q
  1.  D SH2
  1.  S I=0
  1.  F  S I=$O(^LAB(62.4,LA7624,3,I)) Q:'I  D  Q:LA7EXIT
  1.  . I ($Y+6)>IOSL D HDR Q:LA7EXIT  D SH2 Q:LA7EXIT
  1.  . S X=^LAB(62.4,LA7624,3,I,0),X(2)=$G(^LAB(62.4,LA7624,3,I,2))
  1.  . S LR60=+X,LR61=$P(X(2),"^",13)
  1.  . W !,$J(I,2),?3,$E($P(^LAB(60,LR60,0),"^"),1,25)
  1.  . S LA7CODE=$P(X,"^",6)
  1.  . W ?30,$S(LA7CODE'="":LA7CODE,1:"<Missing>")
  1.  . I LR61 S X=$P(^LAB(61,LR61,0),"^")_"("_LR61_")"
  1.  . E  S X="<Missing>"
  1.  . W ?55,X
  1.  . S X="("_$P($$GET1^DIQ(60,LR60_",",5),";",2)_")"
  1.  . W !,?3,$E($$GET1^DIQ(60,LR60_",",400),1,25-$L(X))_X
  1.  . I LA7CODE?5N1"."4N D
  1.  . . S Y=$O(^LAM("C",LA7CODE_" ",0))
  1.  . . I Y W ?30,$E($P(^LAM(Y,0),"^"),1,20)
  1.  . S X=$S(LR61:$E($$GET1^DIQ(61,LR61_",","LEDI HL7:HL7 ABBR"),1,14),1:" ")
  1.  . W ?55,$S(X'="":X,1:"<Missing>"),!
  1.  . S LR64=+$P($G(^LAB(60,LR60,64)),"^",2),LR64(0)=$G(^LAM(LR64,0))
  1.  . I LR64<1 W ?3,"Warning - test does not have RESULT NLT CODE assigned.",!
  1.  . I LR64>0,$P(LR64(0),"^",2)'=LA7CODE W ?3,"Warning - RESULT NLT CODE does not match UI TEST CODE."
  1.  ;
  1.  I '$D(ZTQUEUED),'LA7EXIT,$E(IOST,1,2)="C-" D TERM
  1.  D CLEAN
  1.  Q
  1.  ;
  1.  ;
  1. CLEAN ; Clean up and quit
  1.  I $E(IOST,1,2)'="C-"  W @IOF
  1.  I '$D(ZTQUEUED) D ^%ZISC
  1.  E  S ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;
  1. HDR ; Header for test code mapping
  1.  I '$D(ZTQUEUED),LA7PAGE,$E(IOST,1,2)="C-" D TERM Q:$G(LA7EXIT)
  1.  W @IOF S $X=0
  1.  S LA7PAGE=LA7PAGE+1
  1.  W !,"Point of Care Test Code Mapping",?IOM-20," Page: ",LA7PAGE
  1.  W !," for interface: ",$P(LA7624(0),"^"),?IOM-23," Printed: ",LA7NOW
  1.  W !,LA7LINE,!
  1.  Q
  1.  ;
  1.  ;
  1. SH1 ; Sub header #1
  1.  W !,"POC Order Test Codes using Load/Work List: ",$P(^LRO(68.2,LRLL,0),"^")
  1.  W !,"#  Lab Test",?30,"Order NLT Code",?50,"Specimen(IEN)",?70,"HL7 Spec"
  1.  W !,?30,"Order NLT Name",?50,"Collection Sample",?70,"WKLD Code"
  1.  W !,LA7LINE2,!
  1.  Q
  1.  ;
  1.  ;
  1. SH2 ; Sub head #2
  1.  W !,"POC Result Test Codes using Auto Instrument: ",$P(LA7624(0),"^")
  1.  W !,"#  Lab Test",?30,"Result NLT Code",?55,"Specimen(IEN)"
  1.  W !,"   Dataname(IEN)",?30,"Result NLT Name",?55,"HL7 Spec"
  1.  W !,LA7LINE2,!
  1.  Q
  1.  ;
  1.  ;
  1. TERM ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="E" D ^DIR S:$D(DIRUT) LA7EXIT=1
  1.  Q