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

LA7UCFG.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; ZEXCEPT is used to identify variables which are external to a specific TAG
  1. ; used in conjunction with Eclipse M-editor.
  1. ;
  1. Q
  1. ;
  1. EN ; Configure files #62.48 and #62.4 and auto release
  1. N DIR,DIROUT,DIRUT,DUOUT,LA7QUIT,X,Y
  1. F D Q:$D(DIRUT)
  1. . 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"
  1. . S DIR(0)=DIR(0)_";7:Convert LAB UI 1.6 to Enhanced Acknowledgement Mode"
  1. . S DIR("A")="Select which function to configure/report"
  1. . D ^DIR
  1. . I $D(DIRUT) Q
  1. . I Y=1 D E6248 Q
  1. . I Y=2 D Q
  1. . . S LA7QUIT=0
  1. . . F D E624 Q:LA7QUIT
  1. . I Y=3 D EDITPAR^XPAREDIT("LA UI AUTO RELEASE MASTER") Q
  1. . I Y=4 D PRINT Q
  1. . I Y=5 D ENKEY Q
  1. . I Y=6 D EDITPAR^XPAREDIT("LA UI PROVIDER CONTACT INFO") Q
  1. . I Y=7 D ENACK^LA7UCFG1 Q
  1. Q
  1. ;
  1. ;
  1. E6248 ; Setup/edit file #62.48
  1. ;
  1. N DA,DIC,DIE,DLAYGO,DR,LA76248,X,Y
  1. W !
  1. S DIC="^LAHM(62.48,",DIC(0)="AELMQ",DIC("S")="I $P(^(0),U,9)=1",DLAYGO=62.48
  1. D ^DIC K DIC("S")
  1. I Y<1 Q
  1. S (DA,LA76248)=+Y
  1. L +^LAHM(62.48,LA76248):DILOCKTM
  1. I '$T W !?5,"Another user is editing this entry." Q
  1. S DIE=DIC,DR="2;3;4;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,DLAYGO,DR,FDA,LA7624,LA76248,LA7ERR,X,Y
  1. ;
  1. ;ZEXCEPT: LA7QUIT
  1. ;
  1. W !
  1. S DIC="^LAB(62.4,",DIC(0)="AELMQ",DIC("S")="I $P(^(0),U)'[""LA7V"",$P(^(0),U)'[""LA7P""",DLAYGO=62.4
  1. D ^DIC K DIC("S")
  1. I Y<1 S LA7QUIT=1 Q
  1. S (DA,LA7624)=+Y
  1. ;
  1. L +^LAB(62.4,LA7624):DILOCKTM
  1. I '$T W !?5,"Another user is editing this entry." Q
  1. ;
  1. S DIE=DIC,DR=".01;3;5;6;8;10;11;12;18;.02;95;98;99;30;107"
  1. I DUZ(0)="@" S DR(2,62.41)=".01;2;6;15;7;8;9;12;13;14;16;17;18;19"
  1. E S DR(2,62.41)=".01;6;15;7;8;9;12;13;14;16;17;18;19"
  1. D ^DIE
  1. ;
  1. ; Stuff file build logic into entry if UI interface
  1. S LA76248=$P($G(^LAB(62.4,LA7624,0)),"^",8)
  1. I $D(DA),LA76248,$P($G(^LAHM(62.48,LA76248,0)),"^",9)=1 D
  1. . W !!,"Setting fields for auto download FILE BUILD ENTRY (#93) to: EN"
  1. . W !," FILE BUILD ROUTINE (#94) to: LA7UID"
  1. . S FDA(1,62.4,LA7624_",",93)="EN"
  1. . S FDA(1,62.4,LA7624_",",94)="LA7UID"
  1. . D FILE^DIE("","FDA(1)","LA7ERR(1)")
  1. . W " ...",$S('$D(LA7ERR(1)):"Done",1:"Update FAILED")
  1. . I $D(LA7ERR(1)) W !,"Error Reported by FileMan: ",$G(LA7ERR(1,"DIERR",1,"TEXT",1))
  1. ;
  1. ; If entry set for Auto Release then check related load list for desginated auto release profile.
  1. I $P($G(^LAB(62.4,LA7624,9)),U,11) D
  1. . N DA,DIE,DR,LA7682
  1. . S LA7682=$P($G(^LAB(62.4,LA7624,0)),U,4)
  1. . I $D(^LRO(68.2,"AR",1,LA7682)) Q ; Loadlist already have profile flagged for auto release
  1. . W !!,"As this auto instrument is configured for auto release,"
  1. . W !,"please designate the associated load list profile to be used for auto release.",!
  1. . W !,"Editing load list: ",$P(^LRO(68.2,LA7682,0),U),!
  1. . S DIE="^LRO(68.2,",DA=LA7682,DR=50,DR(2,68.23)="2.4"
  1. . D ^DIE
  1. ;
  1. L -^LAB(62.4,LA7624)
  1. Q
  1. ;
  1. ;
  1. PRINT ; Print lab universal interface configuration report
  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 $P(^(0),U)'[""LA7V"",$P(^(0),U)'[""LA7P"""
  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^LA7UCFG",ZTSAVE("LA7624")="",ZTDESC="Print Lab Universal Interface Configuration Report"
  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 X,Y
  1. N LA7EXIT,LA7LINE,LA7LINE2,LA7NOW,LA7PAGE
  1. N LRLL,LRPROF
  1. S LA7NOW=$$HTE^XLFDT($H),(LA7EXIT,LA7PAGE)=0
  1. S LA7624(0)=$G(^LAB(62.4,LA7624,0))
  1. S LA7LINE=$$REPEAT^XLFSTR("=",IOM)
  1. S LA7LINE2=$$REPEAT^XLFSTR("-",IOM)
  1. D HDR
  1. N ARPCNT,LA7PROXY,LA7PROXID,LA7DIV,LA7SITE,LA7VAF,PCNT,LR60,LRD,LRDN,LRX,XURET
  1. 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"))
  1. ;
  1. W !!,"VistA Application Proxy",?28,"ID/DUZ",?45,"HL7 encoding format",!,LA7LINE2
  1. F LA7PROXY="LRLAB, AUTO VERIFY","LRLAB, AUTO RELEASE" D
  1. . S LA7PROXID=$$FIND1^DIC(200,,"X",LA7PROXY,"B")
  1. . S LA7DIV=+$$KSP^XUPARAM("INST")
  1. . S LA7SITE=$$RETFACID^LA7VHLU2(LA7DIV,0,1)
  1. . S LA7VAF=$$GET1^DIQ(4,LA7DIV_",","AGENCY CODE","I")
  1. . I LA7VAF="V" S LA7SITE="VA"_LA7SITE
  1. . W !,?2,LA7PROXY,?25,$S(LA7PROXID'=0:$J(LA7PROXID,10),1:"** NOT DEFINED **")
  1. . I LA7PROXID'=0 W ?38," ",LA7PROXID_"-"_LA7SITE_"^"_$$HLNAME^XLFNAME(LA7PROXY,"S","^")_"^^^^99VA4"
  1. W !!,"HL7 Components: <ID Number (ST)> ^ <Family Name (FN)> ^ <Given Name (ST)> ^ ^ ^ ^ ^ <Source Table (IS)> ^"
  1. ;
  1. W !!!,"Instrument Auto Download Status.: ",$$GET1^DIQ(62.4,LA7624_",",98)
  1. I $$GET1^DIQ(62.4,LA7624_",",98)'="YES" W !?10,"**Warning - Auto Download not enabled for auto instrument: ",$P(LA7624(0),"^",1)
  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)")
  1. ;
  1. W !!,"Instrument Auto Release Status: ",$$GET1^DIQ(62.4,LA7624_",",99)
  1. ;I $$GET1^DIQ(62.4,LA7624_",",99)'="YES" W !?10,"**Warning - Auto Release not enabled for auto instrument: ",$P(LA7624(0),"^",1)
  1. ;
  1. W !!,"Associated Lab UI Message Configuration: ",$$GET1^DIQ(62.4,LA7624_",",8)
  1. I $$GET1^DIQ(62.4,LA7624_",",8)="" W !?10,"**Warning - Message Configuration not defined for auto instrument: ",$P(LA7624(0),"^",1)
  1. ;
  1. W !!,"Associated Load/Work List: ",$$GET1^DIQ(62.4,LA7624_",",3)
  1. S LRLL=$P(LA7624(0),"^",4) ;load/work list
  1. I 'LRLL W !?10,"**Warning - No load/work list defined for auto instrument: ",$P(LA7624(0),"^",1)
  1. ;
  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
  1. I LRX S XURET=$$DIV4^XUSER(.XURET,.LRX) ;return proxy's divisions
  1. S PCNT=0,ARPCNT=0,LRPROF=0
  1. I LRLL F S LRPROF=$O(^LRO(68.2,LRLL,10,LRPROF)) Q:'LRPROF D
  1. . S PCNT=PCNT+1 ; count profiles
  1. . I $$GET1^DIQ(68.23,LRPROF_","_LRLL_",",2.4)="YES" D
  1. . . S ARPCNT=ARPCNT+1 ;count auto release profiles
  1. . . W !?5,"Auto Release Profile: ",$$GET1^DIQ(68.23,LRPROF_","_LRLL_",",.01)
  1. . . 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
  1. . . W !?11,"Performing Lab: ",$S(LRDN'="":LRDN,1:"** None Defined **")
  1. . . I '$D(XURET(LRD)) D
  1. . . . 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)."
  1. . . . I LRDN="" W !?11,"**Warning - Performing lab required to be specified for Auto Release."
  1. I 'PCNT W !?10,"**Warning - No profile defined for auto release"
  1. I 'ARPCNT W !?10,"**Warning - No profile enabled for auto release"
  1. I ARPCNT>1 W !?10,"**Warning - Multiple profiles enabled for auto release (should only be one)"
  1. ;
  1. I ($Y+6)>IOSL D HDR
  1. I LA7EXIT D CLEAN Q
  1. D SH1
  1. 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
  1. . S LR60=+$P(X(0),"^",1)
  1. . I ($Y+6)>IOSL D HDR Q:LA7EXIT D SH1 Q:LA7EXIT
  1. . 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),"]"
  1. . I $S($P(X(2),"^",13)'="":1,$P(X(2),"^",14)'="":1,1:0) D
  1. . . W !
  1. . . I $P(X(2),"^",13)'="" W ?10,"Specimen: ",$$GET1^DIQ(62.41,I_","_LA7624_",",8)
  1. . . I $P(X(2),"^",14)'="" W ?90,"Urgency: ",$$GET1^DIQ(62.41,I_","_LA7624_",",9)
  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 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
  1. . I ($Y+6)>IOSL D HDR Q:LA7EXIT D SH2 Q:LA7EXIT
  1. . 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)
  1. . 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)
  1. . I $P(X(2),"^",8)'="" W !?10,"Remark Prefix: ",$$GET1^DIQ(62.41,I_","_LA7624_",",19)
  1. . I $$GET1^DIQ(62.41,I_","_LA7624_",",2)'="" W !?10,"Param 1: ",$$GET1^DIQ(62.41,I_","_LA7624_",",2)
  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 lab universal interface configuration report
  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 !,"Lab Universal Interface Configuration Report",?IOM-29," Page: ",LA7PAGE
  1. W !," for interface: ",$P(LA7624(0),"^"),?IOM-32," Printed: ",LA7NOW
  1. W !,LA7LINE,!
  1. Q
  1. ;
  1. ;
  1. SH1 ;Sub header #1
  1. W !!,"ORDERABLE TESTS"
  1. W !,"Entry",?10,"Name",?45,"UI Test Code",?75,"Accession Area",?95,"Data Name [IEN]"
  1. W !,LA7LINE2
  1. Q
  1. ;
  1. ;
  1. SH2 ;Sub head #2
  1. W !!,"REPORTABLE TESTS"
  1. W ?75,"Decimal",?84,"Result to",?95,"Accept",?105,"Ignore",?115,"Remove",?125,"Store"
  1. W !,"Entry",?10,"Name",?45,"UI Test Code",?75,"Places",?85,"Remark",?95,"Results",?105,"Results",?115,"Spaces",?125,"Remarks"
  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
  1. ;
  1. ;
  1. ENKEY ;entry point to holder(s) of lab key(s) option
  1. N DIC,X,Y,LRKEY,LRUSER
  1. 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
  1. . D ^DIC I Y<0 Q
  1. . I '$D(^XUSEC($P(Y,"^",2))) W !!?5,"There are no holders of this key." Q
  1. . S LRKEY($P(Y,"^",2))="" ;array of lab keys
  1. I '$D(LRKEY) W !!,"No security keys selected." Q
  1. I X="^" Q
  1. W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="All USERS" D ^DIR K DIR I $D(DIRUT) Q
  1. I Y=1 S LRUSER="ALL" ;selecting all lab keys
  1. 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
  1. . D ^DIC I Y<0 Q
  1. . S LRUSER(+Y)="" ;array of lab keys
  1. I X="^" Q
  1. S ZTSAVE("LRKEY*")="",ZTSAVE("LRUSER*")=""
  1. W ! D EN^XUTMDEVQ("START^LA7UCFG","USERS HOLDING LAB KEYS",.ZTSAVE,"M") I 'POP Q
  1. W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
  1. Q
  1. ;
  1. ;
  1. START ;print users holding lab keys
  1. N %,I,JJ,KTAB,LIN,LN,LRID,LRK,LRNAM,PG,POP,PRTDT,QFLG,SS,TAB,X,Y
  1. S (PG,QFLG)=0,U="^",$P(LN,"-",IOM+1)="" K ^TMP("LA7UCFG",$J)
  1. D NOW^%DTC S PRTDT=$$FMTE^XLFDT($E(%,1,12))
  1. ;
  1. 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
  1. . S ^TMP("LA7UCFG",$J,$P($G(^VA(200,LRID,0)),"^",1),LRID,LRK)=""
  1. 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
  1. . S ^TMP("LA7UCFG",$J,$P($G(^VA(200,LRID,0)),"^",1),LRID,LRK)=""
  1. ;
  1. D KEYHDR I QFLG D EXIT Q
  1. S LRNAM="" F S LRNAM=$O(^TMP("LA7UCFG",$J,LRNAM)) Q:LRNAM=""!(QFLG) D
  1. . S LRID=0 F S LRID=$O(^TMP("LA7UCFG",$J,LRNAM,LRID)) Q:'LRID D
  1. . . I $Y+4>IOSL!'PG D KEYHDR I QFLG Q
  1. . . W !,$J(LRID,9),?10,LRNAM
  1. . . S LRK="" F S LRK=$O(^TMP("LA7UCFG",$J,LRNAM,LRID,LRK)) Q:LRK="" D
  1. . . . W ?KTAB(LRK),"X"
  1. I '$D(^TMP("LA7UCFG",$J)) W !," ** NO USERS FOR SELECTED LAB KEY(S) **"
  1. ;
  1. ;
  1. EXIT ;
  1. K ^TMP("LA7UCFG",$J)
  1. I $E(IOST,1,2)="C-"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
  1. .S SS=22-$Y F JJ=1:1:SS W !
  1. D ^%ZISC
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. ;
  1. KEYHDR ;header for security key report
  1. I $E(IOST,1,2)="C-" S SS=22-$Y F JJ=1:1:SS W !
  1. I $E(IOST,1,2)="C-",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
  1. I $Y!($E(IOST,1,2)="C-") W @IOF
  1. S PG=PG+1
  1. W !,PRTDT,?IOM-10,"Page: ",PG
  1. S LIN(1)="HOLDERS OF LAB KEYS"
  1. F I=1:1 Q:'$D(LIN(I)) W !,?(IOM\2-($L(LIN(I))\2)),LIN(I)
  1. 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
  1. W !,LN
  1. Q
  1. ;
  1. ;