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