- LA7UCFG ;DALOI/JMC - Configure Lab Universal Interface ;9/26/16 12:13
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**66,88,94**;Sep 27, 1994;Build 1
- ;
- ; ZEXCEPT is used to identify variables which are external to a specific TAG
- ; used in conjunction with Eclipse M-editor.
- ;
- Q
- ;
- EN ; Configure files #62.48 and #62.4 and auto release
- N DIR,DIROUT,DIRUT,DUOUT,LA7QUIT,X,Y
- F D Q:$D(DIRUT)
- . S DIR(0)="SO^1:LA7 MESSAGE PARAMETER (#62.48);2:AUTO INSTRUMENT (#62.4);3:Auto Release System Parameter;4:Configuration Report (132 COL);5:Holders of Lab keys;6:Ordering Provider Contact Parameter"
- . S DIR(0)=DIR(0)_";7:Convert LAB UI 1.6 to Enhanced Acknowledgement Mode"
- . S DIR("A")="Select which function to configure/report"
- . D ^DIR
- . I $D(DIRUT) Q
- . I Y=1 D E6248 Q
- . I Y=2 D Q
- . . S LA7QUIT=0
- . . F D E624 Q:LA7QUIT
- . I Y=3 D EDITPAR^XPAREDIT("LA UI AUTO RELEASE MASTER") Q
- . I Y=4 D PRINT Q
- . I Y=5 D ENKEY Q
- . I Y=6 D EDITPAR^XPAREDIT("LA UI PROVIDER CONTACT INFO") Q
- . I Y=7 D ENACK^LA7UCFG1 Q
- Q
- ;
- ;
- E6248 ; Setup/edit file #62.48
- ;
- N DA,DIC,DIE,DLAYGO,DR,LA76248,X,Y
- W !
- S DIC="^LAHM(62.48,",DIC(0)="AELMQ",DIC("S")="I $P(^(0),U,9)=1",DLAYGO=62.48
- D ^DIC K DIC("S")
- I Y<1 Q
- S (DA,LA76248)=+Y
- L +^LAHM(62.48,LA76248):DILOCKTM
- I '$T W !?5,"Another user is editing this entry." Q
- S DIE=DIC,DR="2;3;4;20"
- D ^DIE
- L -^LAHM(62.48,LA76248)
- Q
- ;
- ;
- E624 ; Setup/edit file #62.4
- ;
- N DA,DIC,DIE,DLAYGO,DR,FDA,LA7624,LA76248,LA7ERR,X,Y
- ;
- ;ZEXCEPT: LA7QUIT
- ;
- W !
- S DIC="^LAB(62.4,",DIC(0)="AELMQ",DIC("S")="I $P(^(0),U)'[""LA7V"",$P(^(0),U)'[""LA7P""",DLAYGO=62.4
- D ^DIC K DIC("S")
- I Y<1 S LA7QUIT=1 Q
- S (DA,LA7624)=+Y
- ;
- L +^LAB(62.4,LA7624):DILOCKTM
- I '$T W !?5,"Another user is editing this entry." Q
- ;
- S DIE=DIC,DR=".01;3;5;6;8;10;11;12;18;.02;95;98;99;30;107"
- I DUZ(0)="@" S DR(2,62.41)=".01;2;6;15;7;8;9;12;13;14;16;17;18;19"
- E S DR(2,62.41)=".01;6;15;7;8;9;12;13;14;16;17;18;19"
- D ^DIE
- ;
- ; Stuff file build logic into entry if UI interface
- S LA76248=$P($G(^LAB(62.4,LA7624,0)),"^",8)
- I $D(DA),LA76248,$P($G(^LAHM(62.48,LA76248,0)),"^",9)=1 D
- . W !!,"Setting fields for auto download FILE BUILD ENTRY (#93) to: EN"
- . W !," FILE BUILD ROUTINE (#94) to: LA7UID"
- . S FDA(1,62.4,LA7624_",",93)="EN"
- . S FDA(1,62.4,LA7624_",",94)="LA7UID"
- . D FILE^DIE("","FDA(1)","LA7ERR(1)")
- . W " ...",$S('$D(LA7ERR(1)):"Done",1:"Update FAILED")
- . I $D(LA7ERR(1)) W !,"Error Reported by FileMan: ",$G(LA7ERR(1,"DIERR",1,"TEXT",1))
- ;
- ; If entry set for Auto Release then check related load list for desginated auto release profile.
- I $P($G(^LAB(62.4,LA7624,9)),U,11) D
- . N DA,DIE,DR,LA7682
- . S LA7682=$P($G(^LAB(62.4,LA7624,0)),U,4)
- . I $D(^LRO(68.2,"AR",1,LA7682)) Q ; Loadlist already have profile flagged for auto release
- . W !!,"As this auto instrument is configured for auto release,"
- . W !,"please designate the associated load list profile to be used for auto release.",!
- . W !,"Editing load list: ",$P(^LRO(68.2,LA7682,0),U),!
- . S DIE="^LRO(68.2,",DA=LA7682,DR=50,DR(2,68.23)="2.4"
- . D ^DIE
- ;
- L -^LAB(62.4,LA7624)
- Q
- ;
- ;
- PRINT ; Print lab universal interface configuration report
- 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 $P(^(0),U)'[""LA7V"",$P(^(0),U)'[""LA7P"""
- 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^LA7UCFG",ZTSAVE("LA7624")="",ZTDESC="Print Lab Universal Interface Configuration Report"
- . D ^%ZTLOAD,^%ZISC
- . D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
- ;
- DQP ; entry point from above and TaskMan
- ;
- N X,Y
- N LA7EXIT,LA7LINE,LA7LINE2,LA7NOW,LA7PAGE
- N LRLL,LRPROF
- S LA7NOW=$$HTE^XLFDT($H),(LA7EXIT,LA7PAGE)=0
- S LA7624(0)=$G(^LAB(62.4,LA7624,0))
- S LA7LINE=$$REPEAT^XLFSTR("=",IOM)
- S LA7LINE2=$$REPEAT^XLFSTR("-",IOM)
- D HDR
- N ARPCNT,LA7PROXY,LA7PROXID,LA7DIV,LA7SITE,LA7VAF,PCNT,LR60,LRD,LRDN,LRX,XURET
- W !,"VistA Lab Auto Release Master: ",$S($$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"E")="":"NO (DISABLED)",1:$$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"E"))
- ;
- W !!,"VistA Application Proxy",?28,"ID/DUZ",?45,"HL7 encoding format",!,LA7LINE2
- F LA7PROXY="LRLAB, AUTO VERIFY","LRLAB, AUTO RELEASE" D
- . S LA7PROXID=$$FIND1^DIC(200,,"X",LA7PROXY,"B")
- . S LA7DIV=+$$KSP^XUPARAM("INST")
- . S LA7SITE=$$RETFACID^LA7VHLU2(LA7DIV,0,1)
- . S LA7VAF=$$GET1^DIQ(4,LA7DIV_",","AGENCY CODE","I")
- . I LA7VAF="V" S LA7SITE="VA"_LA7SITE
- . W !,?2,LA7PROXY,?25,$S(LA7PROXID'=0:$J(LA7PROXID,10),1:"** NOT DEFINED **")
- . I LA7PROXID'=0 W ?38," ",LA7PROXID_"-"_LA7SITE_"^"_$$HLNAME^XLFNAME(LA7PROXY,"S","^")_"^^^^99VA4"
- W !!,"HL7 Components: <ID Number (ST)> ^ <Family Name (FN)> ^ <Given Name (ST)> ^ ^ ^ ^ ^ <Source Table (IS)> ^"
- ;
- W !!!,"Instrument Auto Download Status.: ",$$GET1^DIQ(62.4,LA7624_",",98)
- I $$GET1^DIQ(62.4,LA7624_",",98)'="YES" W !?10,"**Warning - Auto Download not enabled for auto instrument: ",$P(LA7624(0),"^",1)
- W !,"Instrument Auto Download Routine: ",$S($$GET1^DIQ(62.4,LA7624_",",93)'="":$$GET1^DIQ(62.4,LA7624_",",93),1:"(Entry Not Defined)"),$S($$GET1^DIQ(62.4,LA7624_",",94)'="":"^"_$$GET1^DIQ(62.4,LA7624_",",94),1:"(Routine Not Defined)")
- ;
- W !!,"Instrument Auto Release Status: ",$$GET1^DIQ(62.4,LA7624_",",99)
- ;I $$GET1^DIQ(62.4,LA7624_",",99)'="YES" W !?10,"**Warning - Auto Release not enabled for auto instrument: ",$P(LA7624(0),"^",1)
- ;
- W !!,"Associated Lab UI Message Configuration: ",$$GET1^DIQ(62.4,LA7624_",",8)
- I $$GET1^DIQ(62.4,LA7624_",",8)="" W !?10,"**Warning - Message Configuration not defined for auto instrument: ",$P(LA7624(0),"^",1)
- ;
- W !!,"Associated Load/Work List: ",$$GET1^DIQ(62.4,LA7624_",",3)
- S LRLL=$P(LA7624(0),"^",4) ;load/work list
- I 'LRLL W !?10,"**Warning - No load/work list defined for auto instrument: ",$P(LA7624(0),"^",1)
- ;
- S LRX=$$FIND1^DIC(200,"","OX","LRLAB,AUTO RELEASE","B","") I LRX<1 W !?10,"**Warning - Unable to identify proxy 'LRLAB,AUTO RELEASE' in NEW PERSON file" ;find duz of proxy
- I LRX S XURET=$$DIV4^XUSER(.XURET,.LRX) ;return proxy's divisions
- S PCNT=0,ARPCNT=0,LRPROF=0
- I LRLL F S LRPROF=$O(^LRO(68.2,LRLL,10,LRPROF)) Q:'LRPROF D
- . S PCNT=PCNT+1 ; count profiles
- . I $$GET1^DIQ(68.23,LRPROF_","_LRLL_",",2.4)="YES" D
- . . S ARPCNT=ARPCNT+1 ;count auto release profiles
- . . W !?5,"Auto Release Profile: ",$$GET1^DIQ(68.23,LRPROF_","_LRLL_",",.01)
- . . S LRD=+$P($G(^LRO(68.2,LRLL,10,LRPROF,0)),"^",5),LRDN=$$GET1^DIQ(68.23,LRPROF_","_LRLL_",",2.3) ;default reference lab and name
- . . W !?11,"Performing Lab: ",$S(LRDN'="":LRDN,1:"** None Defined **")
- . . I '$D(XURET(LRD)) D
- . . . I LRDN'="" W !?11,"**Warning - 'LRLAB,AUTO RELEASE' proxy has not been assigned division '",LRDN,"' in",!?24,"the file NEW PERSON (#200), field DIVISION (#16)."
- . . . I LRDN="" W !?11,"**Warning - Performing lab required to be specified for Auto Release."
- I 'PCNT W !?10,"**Warning - No profile defined for auto release"
- I 'ARPCNT W !?10,"**Warning - No profile enabled for auto release"
- I ARPCNT>1 W !?10,"**Warning - Multiple profiles enabled for auto release (should only be one)"
- ;
- I ($Y+6)>IOSL D HDR
- I LA7EXIT D CLEAN Q
- D SH1
- S I=0 F S I=$O(^LAB(62.4,LA7624,3,I)) Q:'I S X(0)=$G(^(I,0)),X(2)=$G(^(2)) I $P(X(2),"^",4)=1 D Q:LA7EXIT
- . S LR60=+$P(X(0),"^",1)
- . I ($Y+6)>IOSL D HDR Q:LA7EXIT D SH1 Q:LA7EXIT
- . W !,$J("["_I_"]",4),?5,$$GET1^DIQ(62.41,I_","_LA7624_",",.01),?45,$$GET1^DIQ(62.41,I_","_LA7624_",",6),?75,$$GET1^DIQ(62.41,I_","_LA7624_",",7),?95,$$GET1^DIQ(60,LR60_",",400)," [",$P($G(^LAB(60,LR60,.2)),"^",1),"]"
- . I $S($P(X(2),"^",13)'="":1,$P(X(2),"^",14)'="":1,1:0) D
- . . W !
- . . I $P(X(2),"^",13)'="" W ?10,"Specimen: ",$$GET1^DIQ(62.41,I_","_LA7624_",",8)
- . . I $P(X(2),"^",14)'="" W ?90,"Urgency: ",$$GET1^DIQ(62.41,I_","_LA7624_",",9)
- ;
- 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 S X(2)=$G(^(I,2)) I $P(X(2),"^",3)'=0 D Q:LA7EXIT
- . I ($Y+6)>IOSL D HDR Q:LA7EXIT D SH2 Q:LA7EXIT
- . W !,$J("["_I_"]",4),?5,$$GET1^DIQ(62.41,I_","_LA7624_",",.01),?45,$$GET1^DIQ(62.41,I_","_LA7624_",",6),?75,$J($$GET1^DIQ(62.41,I_","_LA7624_",",12),5),?85,$$GET1^DIQ(62.41,I_","_LA7624_",",13),?95,$$GET1^DIQ(62.41,I_","_LA7624_",",14)
- . W ?105,$$GET1^DIQ(62.41,I_","_LA7624_",",16),?115,$$GET1^DIQ(62.41,I_","_LA7624_",",17),?125,$$GET1^DIQ(62.41,I_","_LA7624_",",18)
- . I $P(X(2),"^",8)'="" W !?10,"Remark Prefix: ",$$GET1^DIQ(62.41,I_","_LA7624_",",19)
- . I $$GET1^DIQ(62.41,I_","_LA7624_",",2)'="" W !?10,"Param 1: ",$$GET1^DIQ(62.41,I_","_LA7624_",",2)
- ;
- 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 lab universal interface configuration report
- I '$D(ZTQUEUED),LA7PAGE,$E(IOST,1,2)="C-" D TERM Q:$G(LA7EXIT)
- W @IOF S $X=0
- S LA7PAGE=LA7PAGE+1
- W !,"Lab Universal Interface Configuration Report",?IOM-29," Page: ",LA7PAGE
- W !," for interface: ",$P(LA7624(0),"^"),?IOM-32," Printed: ",LA7NOW
- W !,LA7LINE,!
- Q
- ;
- ;
- SH1 ;Sub header #1
- W !!,"ORDERABLE TESTS"
- W !,"Entry",?10,"Name",?45,"UI Test Code",?75,"Accession Area",?95,"Data Name [IEN]"
- W !,LA7LINE2
- Q
- ;
- ;
- SH2 ;Sub head #2
- W !!,"REPORTABLE TESTS"
- W ?75,"Decimal",?84,"Result to",?95,"Accept",?105,"Ignore",?115,"Remove",?125,"Store"
- W !,"Entry",?10,"Name",?45,"UI Test Code",?75,"Places",?85,"Remark",?95,"Results",?105,"Results",?115,"Spaces",?125,"Remarks"
- W !,LA7LINE2
- Q
- ;
- ;
- TERM ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="E" D ^DIR S:$D(DIRUT) LA7EXIT=1
- Q
- ;
- ;
- ENKEY ;entry point to holder(s) of lab key(s) option
- N DIC,X,Y,LRKEY,LRUSER
- W ! F S DIC="^DIC(19.1,",DIC(0)="QEAM",DIC("S")="I $E($P(^(0),U,1),1,2)=""LR""",DIC("A")="Select "_$S($D(LRKEY):"Another ",1:"")_"LAB SECURITY KEY NAME: " D Q:Y<0
- . D ^DIC I Y<0 Q
- . I '$D(^XUSEC($P(Y,"^",2))) W !!?5,"There are no holders of this key." Q
- . S LRKEY($P(Y,"^",2))="" ;array of lab keys
- I '$D(LRKEY) W !!,"No security keys selected." Q
- I X="^" Q
- W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="All USERS" D ^DIR K DIR I $D(DIRUT) Q
- I Y=1 S LRUSER="ALL" ;selecting all lab keys
- I 'Y W ! F K DIC S DIC="^VA(200,",DIC(0)="QEAM",DIC("A")="Select "_$S($D(LRUSER):"Another ",1:"")_"USER: " D Q:Y<0
- . D ^DIC I Y<0 Q
- . S LRUSER(+Y)="" ;array of lab keys
- I X="^" Q
- S ZTSAVE("LRKEY*")="",ZTSAVE("LRUSER*")=""
- W ! D EN^XUTMDEVQ("START^LA7UCFG","USERS HOLDING LAB KEYS",.ZTSAVE,"M") I 'POP Q
- W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
- Q
- ;
- ;
- START ;print users holding lab keys
- N %,I,JJ,KTAB,LIN,LN,LRID,LRK,LRNAM,PG,POP,PRTDT,QFLG,SS,TAB,X,Y
- S (PG,QFLG)=0,U="^",$P(LN,"-",IOM+1)="" K ^TMP("LA7UCFG",$J)
- D NOW^%DTC S PRTDT=$$FMTE^XLFDT($E(%,1,12))
- ;
- I $G(LRUSER)="ALL" S LRK="" F S LRK=$O(LRKEY(LRK)) Q:LRK="" S LRID=0 F S LRID=$O(^XUSEC(LRK,LRID)) Q:'LRID D
- . S ^TMP("LA7UCFG",$J,$P($G(^VA(200,LRID,0)),"^",1),LRID,LRK)=""
- I $O(LRUSER(0)) S LRID=0 F S LRID=$O(LRUSER(LRID)) Q:'LRID S LRK="" F S LRK=$O(LRKEY(LRK)) Q:LRK="" I $D(^XUSEC(LRK,LRID)) D
- . S ^TMP("LA7UCFG",$J,$P($G(^VA(200,LRID,0)),"^",1),LRID,LRK)=""
- ;
- D KEYHDR I QFLG D EXIT Q
- S LRNAM="" F S LRNAM=$O(^TMP("LA7UCFG",$J,LRNAM)) Q:LRNAM=""!(QFLG) D
- . S LRID=0 F S LRID=$O(^TMP("LA7UCFG",$J,LRNAM,LRID)) Q:'LRID D
- . . I $Y+4>IOSL!'PG D KEYHDR I QFLG Q
- . . W !,$J(LRID,9),?10,LRNAM
- . . S LRK="" F S LRK=$O(^TMP("LA7UCFG",$J,LRNAM,LRID,LRK)) Q:LRK="" D
- . . . W ?KTAB(LRK),"X"
- I '$D(^TMP("LA7UCFG",$J)) W !," ** NO USERS FOR SELECTED LAB KEY(S) **"
- ;
- ;
- EXIT ;
- K ^TMP("LA7UCFG",$J)
- I $E(IOST,1,2)="C-"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
- .S SS=22-$Y F JJ=1:1:SS W !
- D ^%ZISC
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- ;
- ;
- KEYHDR ;header for security key report
- I $E(IOST,1,2)="C-" S SS=22-$Y F JJ=1:1:SS W !
- I $E(IOST,1,2)="C-",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
- I $Y!($E(IOST,1,2)="C-") W @IOF
- S PG=PG+1
- W !,PRTDT,?IOM-10,"Page: ",PG
- S LIN(1)="HOLDERS OF LAB KEYS"
- F I=1:1 Q:'$D(LIN(I)) W !,?(IOM\2-($L(LIN(I))\2)),LIN(I)
- W !!?1,"DUZ/ID",?10,"NAME" S TAB=40,I="" F S I=$O(LRKEY(I)) Q:I="" S KTAB(I)=TAB+($L(I)/2) W ?TAB,I S TAB=TAB+$L(I)+1
- W !,LN
- Q
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UCFG 12551 printed Feb 18, 2025@23:06:09 Page 2
- LA7UCFG ;DALOI/JMC - Configure Lab Universal Interface ;9/26/16 12:13
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**66,88,94**;Sep 27, 1994;Build 1
- +2 ;
- +3 ; ZEXCEPT is used to identify variables which are external to a specific TAG
- +4 ; used in conjunction with Eclipse M-editor.
- +5 ;
- +6 QUIT
- +7 ;
- EN ; Configure files #62.48 and #62.4 and auto release
- +1 NEW DIR,DIROUT,DIRUT,DUOUT,LA7QUIT,X,Y
- +2 FOR
- Begin DoDot:1
- +3 SET DIR(0)="SO^1:LA7 MESSAGE PARAMETER (#62.48);2:AUTO INSTRUMENT (#62.4);3:Auto Release System Parameter;4:Configuration Report (132 COL);5:Holders of Lab keys;6:Ordering Provider Contact Parameter"
- +4 SET DIR(0)=DIR(0)_";7:Convert LAB UI 1.6 to Enhanced Acknowledgement Mode"
- +5 SET DIR("A")="Select which function to configure/report"
- +6 DO ^DIR
- +7 IF $DATA(DIRUT)
- QUIT
- +8 IF Y=1
- DO E6248
- QUIT
- +9 IF Y=2
- Begin DoDot:2
- +10 SET LA7QUIT=0
- +11 FOR
- DO E624
- if LA7QUIT
- QUIT
- End DoDot:2
- QUIT
- +12 IF Y=3
- DO EDITPAR^XPAREDIT("LA UI AUTO RELEASE MASTER")
- QUIT
- +13 IF Y=4
- DO PRINT
- QUIT
- +14 IF Y=5
- DO ENKEY
- QUIT
- +15 IF Y=6
- DO EDITPAR^XPAREDIT("LA UI PROVIDER CONTACT INFO")
- QUIT
- +16 IF Y=7
- DO ENACK^LA7UCFG1
- QUIT
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +17 QUIT
- +18 ;
- +19 ;
- E6248 ; Setup/edit file #62.48
- +1 ;
- +2 NEW DA,DIC,DIE,DLAYGO,DR,LA76248,X,Y
- +3 WRITE !
- +4 SET DIC="^LAHM(62.48,"
- SET DIC(0)="AELMQ"
- SET DIC("S")="I $P(^(0),U,9)=1"
- SET DLAYGO=62.48
- +5 DO ^DIC
- KILL DIC("S")
- +6 IF Y<1
- QUIT
- +7 SET (DA,LA76248)=+Y
- +8 LOCK +^LAHM(62.48,LA76248):DILOCKTM
- +9 IF '$TEST
- WRITE !?5,"Another user is editing this entry."
- QUIT
- +10 SET DIE=DIC
- SET DR="2;3;4;20"
- +11 DO ^DIE
- +12 LOCK -^LAHM(62.48,LA76248)
- +13 QUIT
- +14 ;
- +15 ;
- E624 ; Setup/edit file #62.4
- +1 ;
- +2 NEW DA,DIC,DIE,DLAYGO,DR,FDA,LA7624,LA76248,LA7ERR,X,Y
- +3 ;
- +4 ;ZEXCEPT: LA7QUIT
- +5 ;
- +6 WRITE !
- +7 SET DIC="^LAB(62.4,"
- SET DIC(0)="AELMQ"
- SET DIC("S")="I $P(^(0),U)'[""LA7V"",$P(^(0),U)'[""LA7P"""
- SET DLAYGO=62.4
- +8 DO ^DIC
- KILL DIC("S")
- +9 IF Y<1
- SET LA7QUIT=1
- QUIT
- +10 SET (DA,LA7624)=+Y
- +11 ;
- +12 LOCK +^LAB(62.4,LA7624):DILOCKTM
- +13 IF '$TEST
- WRITE !?5,"Another user is editing this entry."
- QUIT
- +14 ;
- +15 SET DIE=DIC
- SET DR=".01;3;5;6;8;10;11;12;18;.02;95;98;99;30;107"
- +16 IF DUZ(0)="@"
- SET DR(2,62.41)=".01;2;6;15;7;8;9;12;13;14;16;17;18;19"
- +17 IF '$TEST
- SET DR(2,62.41)=".01;6;15;7;8;9;12;13;14;16;17;18;19"
- +18 DO ^DIE
- +19 ;
- +20 ; Stuff file build logic into entry if UI interface
- +21 SET LA76248=$PIECE($GET(^LAB(62.4,LA7624,0)),"^",8)
- +22 IF $DATA(DA)
- IF LA76248
- IF $PIECE($GET(^LAHM(62.48,LA76248,0)),"^",9)=1
- Begin DoDot:1
- +23 WRITE !!,"Setting fields for auto download FILE BUILD ENTRY (#93) to: EN"
- +24 WRITE !," FILE BUILD ROUTINE (#94) to: LA7UID"
- +25 SET FDA(1,62.4,LA7624_",",93)="EN"
- +26 SET FDA(1,62.4,LA7624_",",94)="LA7UID"
- +27 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
- +28 WRITE " ...",$SELECT('$DATA(LA7ERR(1)):"Done",1:"Update FAILED")
- +29 IF $DATA(LA7ERR(1))
- WRITE !,"Error Reported by FileMan: ",$GET(LA7ERR(1,"DIERR",1,"TEXT",1))
- End DoDot:1
- +30 ;
- +31 ; If entry set for Auto Release then check related load list for desginated auto release profile.
- +32 IF $PIECE($GET(^LAB(62.4,LA7624,9)),U,11)
- Begin DoDot:1
- +33 NEW DA,DIE,DR,LA7682
- +34 SET LA7682=$PIECE($GET(^LAB(62.4,LA7624,0)),U,4)
- +35 ; Loadlist already have profile flagged for auto release
- IF $DATA(^LRO(68.2,"AR",1,LA7682))
- QUIT
- +36 WRITE !!,"As this auto instrument is configured for auto release,"
- +37 WRITE !,"please designate the associated load list profile to be used for auto release.",!
- +38 WRITE !,"Editing load list: ",$PIECE(^LRO(68.2,LA7682,0),U),!
- +39 SET DIE="^LRO(68.2,"
- SET DA=LA7682
- SET DR=50
- SET DR(2,68.23)="2.4"
- +40 DO ^DIE
- End DoDot:1
- +41 ;
- +42 LOCK -^LAB(62.4,LA7624)
- +43 QUIT
- +44 ;
- +45 ;
- PRINT ; Print lab universal interface configuration report
- +1 NEW %ZIS,DIC,LA7624,ZTDTH,ZTSK,ZTRTN,ZTIO,ZTSAVE,X,Y
- +2 ;
- +3 DO EN^DDIOL("","","!")
- +4 SET DIC="^LAB(62.4,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $P(^(0),U)'[""LA7V"",$P(^(0),U)'[""LA7P"""
- +5 DO ^DIC
- +6 IF Y<1
- QUIT
- +7 SET LA7624=+Y
- +8 ;
- +9 SET %ZIS="MQ"
- DO ^%ZIS
- +10 IF POP
- DO HOME^%ZIS
- QUIT
- +11 IF $DATA(IO("Q"))
- Begin DoDot:1
- +12 SET ZTRTN="DQP^LA7UCFG"
- SET ZTSAVE("LA7624")=""
- SET ZTDESC="Print Lab Universal Interface Configuration Report"
- +13 DO ^%ZTLOAD
- DO ^%ZISC
- +14 DO EN^DDIOL("Request "_$SELECT($GET(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
- End DoDot:1
- QUIT
- +15 ;
- DQP ; entry point from above and TaskMan
- +1 ;
- +2 NEW X,Y
- +3 NEW LA7EXIT,LA7LINE,LA7LINE2,LA7NOW,LA7PAGE
- +4 NEW LRLL,LRPROF
- +5 SET LA7NOW=$$HTE^XLFDT($HOROLOG)
- SET (LA7EXIT,LA7PAGE)=0
- +6 SET LA7624(0)=$GET(^LAB(62.4,LA7624,0))
- +7 SET LA7LINE=$$REPEAT^XLFSTR("=",IOM)
- +8 SET LA7LINE2=$$REPEAT^XLFSTR("-",IOM)
- +9 DO HDR
- +10 NEW ARPCNT,LA7PROXY,LA7PROXID,LA7DIV,LA7SITE,LA7VAF,PCNT,LR60,LRD,LRDN,LRX,XURET
- +11 WRITE !,"VistA Lab Auto Release Master: ",$SELECT($$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"E")="":"NO (DISABLED)",1:$$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"E"))
- +12 ;
- +13 WRITE !!,"VistA Application Proxy",?28,"ID/DUZ",?45,"HL7 encoding format",!,LA7LINE2
- +14 FOR LA7PROXY="LRLAB, AUTO VERIFY","LRLAB, AUTO RELEASE"
- Begin DoDot:1
- +15 SET LA7PROXID=$$FIND1^DIC(200,,"X",LA7PROXY,"B")
- +16 SET LA7DIV=+$$KSP^XUPARAM("INST")
- +17 SET LA7SITE=$$RETFACID^LA7VHLU2(LA7DIV,0,1)
- +18 SET LA7VAF=$$GET1^DIQ(4,LA7DIV_",","AGENCY CODE","I")
- +19 IF LA7VAF="V"
- SET LA7SITE="VA"_LA7SITE
- +20 WRITE !,?2,LA7PROXY,?25,$SELECT(LA7PROXID'=0:$JUSTIFY(LA7PROXID,10),1:"** NOT DEFINED **")
- +21 IF LA7PROXID'=0
- WRITE ?38," ",LA7PROXID_"-"_LA7SITE_"^"_$$HLNAME^XLFNAME(LA7PROXY,"S","^")_"^^^^99VA4"
- End DoDot:1
- +22 WRITE !!,"HL7 Components: <ID Number (ST)> ^ <Family Name (FN)> ^ <Given Name (ST)> ^ ^ ^ ^ ^ <Source Table (IS)> ^"
- +23 ;
- +24 WRITE !!!,"Instrument Auto Download Status.: ",$$GET1^DIQ(62.4,LA7624_",",98)
- +25 IF $$GET1^DIQ(62.4,LA7624_",",98)'="YES"
- WRITE !?10,"**Warning - Auto Download not enabled for auto instrument: ",$PIECE(LA7624(0),"^",1)
- +26 WRITE !,"Instrument Auto Download Routine: ",$SELECT($$GET1^DIQ(62.4,LA7624_",",93)'="":$$GET1^DIQ(62.4,LA7624_",",93),1:"(Entry Not Defined)"),$SELECT($$GET1^DIQ(62.4,LA7624_",",94)'="":"^"_$$GET1^DIQ(62.4,LA7624_",",94),1:"(Routine Not Define
- d)")
- +27 ;
- +28 WRITE !!,"Instrument Auto Release Status: ",$$GET1^DIQ(62.4,LA7624_",",99)
- +29 ;I $$GET1^DIQ(62.4,LA7624_",",99)'="YES" W !?10,"**Warning - Auto Release not enabled for auto instrument: ",$P(LA7624(0),"^",1)
- +30 ;
- +31 WRITE !!,"Associated Lab UI Message Configuration: ",$$GET1^DIQ(62.4,LA7624_",",8)
- +32 IF $$GET1^DIQ(62.4,LA7624_",",8)=""
- WRITE !?10,"**Warning - Message Configuration not defined for auto instrument: ",$PIECE(LA7624(0),"^",1)
- +33 ;
- +34 WRITE !!,"Associated Load/Work List: ",$$GET1^DIQ(62.4,LA7624_",",3)
- +35 ;load/work list
- SET LRLL=$PIECE(LA7624(0),"^",4)
- +36 IF 'LRLL
- WRITE !?10,"**Warning - No load/work list defined for auto instrument: ",$PIECE(LA7624(0),"^",1)
- +37 ;
- +38 ;find duz of proxy
- SET LRX=$$FIND1^DIC(200,"","OX","LRLAB,AUTO RELEASE","B","")
- IF LRX<1
- WRITE !?10,"**Warning - Unable to identify proxy 'LRLAB,AUTO RELEASE' in NEW PERSON file"
- +39 ;return proxy's divisions
- IF LRX
- SET XURET=$$DIV4^XUSER(.XURET,.LRX)
- +40 SET PCNT=0
- SET ARPCNT=0
- SET LRPROF=0
- +41 IF LRLL
- FOR
- SET LRPROF=$ORDER(^LRO(68.2,LRLL,10,LRPROF))
- if 'LRPROF
- QUIT
- Begin DoDot:1
- +42 ; count profiles
- SET PCNT=PCNT+1
- +43 IF $$GET1^DIQ(68.23,LRPROF_","_LRLL_",",2.4)="YES"
- Begin DoDot:2
- +44 ;count auto release profiles
- SET ARPCNT=ARPCNT+1
- +45 WRITE !?5,"Auto Release Profile: ",$$GET1^DIQ(68.23,LRPROF_","_LRLL_",",.01)
- +46 ;default reference lab and name
- SET LRD=+$PIECE($GET(^LRO(68.2,LRLL,10,LRPROF,0)),"^",5)
- SET LRDN=$$GET1^DIQ(68.23,LRPROF_","_LRLL_",",2.3)
- +47 WRITE !?11,"Performing Lab: ",$SELECT(LRDN'="":LRDN,1:"** None Defined **")
- +48 IF '$DATA(XURET(LRD))
- Begin DoDot:3
- +49 IF LRDN'=""
- WRITE !?11,"**Warning - 'LRLAB,AUTO RELEASE' proxy has not been assigned division '",LRDN,"' in",!?24,"the file NEW PERSON (#200), field DIVISION (#16)."
- +50 IF LRDN=""
- WRITE !?11,"**Warning - Performing lab required to be specified for Auto Release."
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +51 IF 'PCNT
- WRITE !?10,"**Warning - No profile defined for auto release"
- +52 IF 'ARPCNT
- WRITE !?10,"**Warning - No profile enabled for auto release"
- +53 IF ARPCNT>1
- WRITE !?10,"**Warning - Multiple profiles enabled for auto release (should only be one)"
- +54 ;
- +55 IF ($Y+6)>IOSL
- DO HDR
- +56 IF LA7EXIT
- DO CLEAN
- QUIT
- +57 DO SH1
- +58 SET I=0
- FOR
- SET I=$ORDER(^LAB(62.4,LA7624,3,I))
- if 'I
- QUIT
- SET X(0)=$GET(^(I,0))
- SET X(2)=$GET(^(2))
- IF $PIECE(X(2),"^",4)=1
- Begin DoDot:1
- +59 SET LR60=+$PIECE(X(0),"^",1)
- +60 IF ($Y+6)>IOSL
- DO HDR
- if LA7EXIT
- QUIT
- DO SH1
- if LA7EXIT
- QUIT
- +61 WRITE !,$JUSTIFY("["_I_"]",4),?5,$$GET1^DIQ(62.41,I_","_LA7624_",",.01),?45,$$GET1^DIQ(62.41,I_","_LA7624_",",6),?75,$$GET1^DIQ(62.41,I_","_LA7624_",",7),?95,$$GET1^DIQ(60,LR60_",",400)," [",$PIECE($GET(^LAB(60,LR60,.2)),"^",1),"]"
- +62 IF $SELECT($PIECE(X(2),"^",13)'="":1,$PIECE(X(2),"^",14)'="":1,1:0)
- Begin DoDot:2
- +63 WRITE !
- +64 IF $PIECE(X(2),"^",13)'=""
- WRITE ?10,"Specimen: ",$$GET1^DIQ(62.41,I_","_LA7624_",",8)
- +65 IF $PIECE(X(2),"^",14)'=""
- WRITE ?90,"Urgency: ",$$GET1^DIQ(62.41,I_","_LA7624_",",9)
- End DoDot:2
- End DoDot:1
- if LA7EXIT
- QUIT
- +66 ;
- +67 IF LA7EXIT
- DO CLEAN
- QUIT
- +68 IF ($Y+6)>IOSL
- DO HDR
- +69 IF LA7EXIT
- DO CLEAN
- QUIT
- +70 DO SH2
- +71 SET I=0
- FOR
- SET I=$ORDER(^LAB(62.4,LA7624,3,I))
- if 'I
- QUIT
- SET X(2)=$GET(^(I,2))
- IF $PIECE(X(2),"^",3)'=0
- Begin DoDot:1
- +72 IF ($Y+6)>IOSL
- DO HDR
- if LA7EXIT
- QUIT
- DO SH2
- if LA7EXIT
- QUIT
- +73 WRITE !,$JUSTIFY("["_I_"]",4),?5,$$GET1^DIQ(62.41,I_","_LA7624_",",.01),?45,$$GET1^DIQ(62.41,I_","_LA7624_",",6),?75,$JUSTIFY($$GET1^DIQ(62.41,I_","_LA7624_",",12),5),?85,$$GET1^DIQ(62.41,I_","_LA7624_",",13),?95,$$GET1^DIQ(62.41,I_
- ","_LA7624_",",14)
- +74 WRITE ?105,$$GET1^DIQ(62.41,I_","_LA7624_",",16),?115,$$GET1^DIQ(62.41,I_","_LA7624_",",17),?125,$$GET1^DIQ(62.41,I_","_LA7624_",",18)
- +75 IF $PIECE(X(2),"^",8)'=""
- WRITE !?10,"Remark Prefix: ",$$GET1^DIQ(62.41,I_","_LA7624_",",19)
- +76 IF $$GET1^DIQ(62.41,I_","_LA7624_",",2)'=""
- WRITE !?10,"Param 1: ",$$GET1^DIQ(62.41,I_","_LA7624_",",2)
- End DoDot:1
- if LA7EXIT
- QUIT
- +77 ;
- +78 IF '$DATA(ZTQUEUED)
- IF 'LA7EXIT
- IF $EXTRACT(IOST,1,2)="C-"
- DO TERM
- +79 DO CLEAN
- +80 QUIT
- +81 ;
- +82 ;
- CLEAN ; Clean up and quit
- +1 IF $EXTRACT(IOST,1,2)'="C-"
- WRITE @IOF
- +2 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- +3 IF '$TEST
- SET ZTREQ="@"
- +4 QUIT
- +5 ;
- +6 ;
- HDR ; Header for lab universal interface configuration report
- +1 IF '$DATA(ZTQUEUED)
- IF LA7PAGE
- IF $EXTRACT(IOST,1,2)="C-"
- DO TERM
- if $GET(LA7EXIT)
- QUIT
- +2 WRITE @IOF
- SET $X=0
- +3 SET LA7PAGE=LA7PAGE+1
- +4 WRITE !,"Lab Universal Interface Configuration Report",?IOM-29," Page: ",LA7PAGE
- +5 WRITE !," for interface: ",$PIECE(LA7624(0),"^"),?IOM-32," Printed: ",LA7NOW
- +6 WRITE !,LA7LINE,!
- +7 QUIT
- +8 ;
- +9 ;
- SH1 ;Sub header #1
- +1 WRITE !!,"ORDERABLE TESTS"
- +2 WRITE !,"Entry",?10,"Name",?45,"UI Test Code",?75,"Accession Area",?95,"Data Name [IEN]"
- +3 WRITE !,LA7LINE2
- +4 QUIT
- +5 ;
- +6 ;
- SH2 ;Sub head #2
- +1 WRITE !!,"REPORTABLE TESTS"
- +2 WRITE ?75,"Decimal",?84,"Result to",?95,"Accept",?105,"Ignore",?115,"Remove",?125,"Store"
- +3 WRITE !,"Entry",?10,"Name",?45,"UI Test Code",?75,"Places",?85,"Remark",?95,"Results",?105,"Results",?115,"Spaces",?125,"Remarks"
- +4 WRITE !,LA7LINE2
- +5 QUIT
- +6 ;
- +7 ;
- TERM ;
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- SET LA7EXIT=1
- +3 QUIT
- +4 ;
- +5 ;
- ENKEY ;entry point to holder(s) of lab key(s) option
- +1 NEW DIC,X,Y,LRKEY,LRUSER
- +2 WRITE !
- FOR
- SET DIC="^DIC(19.1,"
- SET DIC(0)="QEAM"
- SET DIC("S")="I $E($P(^(0),U,1),1,2)=""LR"""
- SET DIC("A")="Select "_$SELECT($DATA(LRKEY):"Another ",1:"")_"LAB SECURITY KEY NAME: "
- Begin DoDot:1
- +3 DO ^DIC
- IF Y<0
- QUIT
- +4 IF '$DATA(^XUSEC($PIECE(Y,"^",2)))
- WRITE !!?5,"There are no holders of this key."
- QUIT
- +5 ;array of lab keys
- SET LRKEY($PIECE(Y,"^",2))=""
- End DoDot:1
- if Y<0
- QUIT
- +6 IF '$DATA(LRKEY)
- WRITE !!,"No security keys selected."
- QUIT
- +7 IF X="^"
- QUIT
- +8 WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="Yes"
- SET DIR("A")="All USERS"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- QUIT
- +9 ;selecting all lab keys
- IF Y=1
- SET LRUSER="ALL"
- +10 IF 'Y
- WRITE !
- FOR
- KILL DIC
- SET DIC="^VA(200,"
- SET DIC(0)="QEAM"
- SET DIC("A")="Select "_$SELECT($DATA(LRUSER):"Another ",1:"")_"USER: "
- Begin DoDot:1
- +11 DO ^DIC
- IF Y<0
- QUIT
- +12 ;array of lab keys
- SET LRUSER(+Y)=""
- End DoDot:1
- if Y<0
- QUIT
- +13 IF X="^"
- QUIT
- +14 SET ZTSAVE("LRKEY*")=""
- SET ZTSAVE("LRUSER*")=""
- +15 WRITE !
- DO EN^XUTMDEVQ("START^LA7UCFG","USERS HOLDING LAB KEYS",.ZTSAVE,"M")
- IF 'POP
- QUIT
- +16 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
- +17 QUIT
- +18 ;
- +19 ;
- START ;print users holding lab keys
- +1 NEW %,I,JJ,KTAB,LIN,LN,LRID,LRK,LRNAM,PG,POP,PRTDT,QFLG,SS,TAB,X,Y
- +2 SET (PG,QFLG)=0
- SET U="^"
- SET $PIECE(LN,"-",IOM+1)=""
- KILL ^TMP("LA7UCFG",$JOB)
- +3 DO NOW^%DTC
- SET PRTDT=$$FMTE^XLFDT($EXTRACT(%,1,12))
- +4 ;
- +5 IF $GET(LRUSER)="ALL"
- SET LRK=""
- FOR
- SET LRK=$ORDER(LRKEY(LRK))
- if LRK=""
- QUIT
- SET LRID=0
- FOR
- SET LRID=$ORDER(^XUSEC(LRK,LRID))
- if 'LRID
- QUIT
- Begin DoDot:1
- +6 SET ^TMP("LA7UCFG",$JOB,$PIECE($GET(^VA(200,LRID,0)),"^",1),LRID,LRK)=""
- End DoDot:1
- +7 IF $ORDER(LRUSER(0))
- SET LRID=0
- FOR
- SET LRID=$ORDER(LRUSER(LRID))
- if 'LRID
- QUIT
- SET LRK=""
- FOR
- SET LRK=$ORDER(LRKEY(LRK))
- if LRK=""
- QUIT
- IF $DATA(^XUSEC(LRK,LRID))
- Begin DoDot:1
- +8 SET ^TMP("LA7UCFG",$JOB,$PIECE($GET(^VA(200,LRID,0)),"^",1),LRID,LRK)=""
- End DoDot:1
- +9 ;
- +10 DO KEYHDR
- IF QFLG
- DO EXIT
- QUIT
- +11 SET LRNAM=""
- FOR
- SET LRNAM=$ORDER(^TMP("LA7UCFG",$JOB,LRNAM))
- if LRNAM=""!(QFLG)
- QUIT
- Begin DoDot:1
- +12 SET LRID=0
- FOR
- SET LRID=$ORDER(^TMP("LA7UCFG",$JOB,LRNAM,LRID))
- if 'LRID
- QUIT
- Begin DoDot:2
- +13 IF $Y+4>IOSL!'PG
- DO KEYHDR
- IF QFLG
- QUIT
- +14 WRITE !,$JUSTIFY(LRID,9),?10,LRNAM
- +15 SET LRK=""
- FOR
- SET LRK=$ORDER(^TMP("LA7UCFG",$JOB,LRNAM,LRID,LRK))
- if LRK=""
- QUIT
- Begin DoDot:3
- +16 WRITE ?KTAB(LRK),"X"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 IF '$DATA(^TMP("LA7UCFG",$JOB))
- WRITE !," ** NO USERS FOR SELECTED LAB KEY(S) **"
- +18 ;
- +19 ;
- EXIT ;
- +1 KILL ^TMP("LA7UCFG",$JOB)
- +2 IF $EXTRACT(IOST,1,2)="C-"&('QFLG)
- SET DIR(0)="E"
- Begin DoDot:1
- +3 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- End DoDot:1
- DO ^DIR
- KILL DIR
- +4 DO ^%ZISC
- +5 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +6 QUIT
- +7 ;
- +8 ;
- KEYHDR ;header for security key report
- +1 IF $EXTRACT(IOST,1,2)="C-"
- SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +2 IF $EXTRACT(IOST,1,2)="C-"
- IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- IF 'Y
- SET QFLG=1
- QUIT
- +3 IF $Y!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- +4 SET PG=PG+1
- +5 WRITE !,PRTDT,?IOM-10,"Page: ",PG
- +6 SET LIN(1)="HOLDERS OF LAB KEYS"
- +7 FOR I=1:1
- if '$DATA(LIN(I))
- QUIT
- WRITE !,?(IOM\2-($LENGTH(LIN(I))\2)),LIN(I)
- +8 WRITE !!?1,"DUZ/ID",?10,"NAME"
- SET TAB=40
- SET I=""
- FOR
- SET I=$ORDER(LRKEY(I))
- if I=""
- QUIT
- SET KTAB(I)=TAB+($LENGTH(I)/2)
- WRITE ?TAB,I
- SET TAB=TAB+$LENGTH(I)+1
- +9 WRITE !,LN
- +10 QUIT
- +11 ;
- +12 ;