LR664L ; BPFO/DTG - LAB LOAD OF ^LAB FILE 66.4 FROM PATCH LR*5.2*468 ;02/10/2016
;;5.2;LAB SERVICE;**468**;FEB 10 2016;Build 64
;
; Adding in POST call to initiate 66.3 file seeding from HDI
;
; This routine uses the following IA's:
; #4640 - ^HDISVF01 calls (supported)
; #4639 - ^HDISVCMR calls (supported)
; #4651 - ^HDISVF09 calls (supported)
;
EN ;
N WB,E,X,WE,AA,A,B,C,DA,DIC,D,DIE,LRM,LRMS,LRN,LRNT,DR,Y
S U="^" I $G(DT)="" S DT=$$DT^XLFDT
S WB=$$SITE^VASITE,WB=$P(WB,U,1)
I (+WB)<1 W !,*7," DEFAULT INSTITUTION NOT SET. UPDATE NOT RUN" G DONE
;S D=$$GET1^DIQ(4,WB_",",.01,"I")
;I D="" W !,*7," DEFAULT INSTITUTION NOT FOUND IN FILE 4. UPDATE NOT RUN" G DONE
S E=$O(^LAB(66.4,"B",WB,0))
I E'="" S WE=$$NS^XUAF4(WB),X=$P(WE,U,1),DIC="^LAB(66.4,",DIC(0)="B" D ^DIC G:(+Y>0) ENA W !,*7," NOT FOUND" G DONE
S X=WB S DIC="^LAB(66.4,",DIC(0)="L" D FILE^DICN
I '$P(Y,U,3) W !,*7,"NOT ABLE TO CREATE RECORD FOR ",D G DONE
ENA ; come here to file update
S (DA,LRNT)=+Y,DR=""
; DOMAIN for site e-mail group
S LRM=""
I ",402,436,438,508,518,520,521,523,529,538,540,541,546,550,552,554,568,570,573,575,589,590,596,600,607,610,612,619,626,629,631,637,642,644,646,649,650,657,658,662,667,671,672,675,676,678,687,405,442,459,537,583,"[","_WB_"," D TGET G TDONE
I ",636,648,655,664,668,679,740,437,509,564,598,603,659,663,504,512,515,548,586,674,553,578,581,593,673,757,358,516,654,501,519,534,556,557,605,562,580,608,652,653,460,620,621,630,506,463,526,539,618,692,502,585,"[","_WB_"," D TGET G TDONE
I ",666,693,756,613,623,632,660,544,549,565,503,640,595,558,688,614,542,691,531,528,695,517,561,689,635,656,"[","_WB_"," D TGET G TDONE
TDONE I LRM'="" S LRMS="S.LRLABSERVER@"_$P(LRM,"@",2),DR="2///"_LRM_";3///"_LRMS G NMAIL
S A=$$SITE^VASITE I A="" G NMAIL
S C=$$KSP^XUPARAM("WHERE") I C="" G NMAIL
; S LRM="G.LMI@"_C,LRMS="S.LRLABSERVER@"_C,DR="2///"_LRM_";3///"_LRMS
S LRM="G.LMI@"_C,LRMS="S.LRLABSERVER@"_C,DR="2///"_LRM
G NMAIL
;
; ntrt group mail address
NMAIL S LRN="G.LABORATORY NTRT@DOMAIN.EXT"
S:$G(DR)'="" DR=DR_";" S DR=DR_"1///"_LRN
;ISAAC ACTIVE
S:$G(DR)'="" DR=DR_";" S DR=DR_".05///N"
;SEND METHOD
S:$G(DR)'="" DR=DR_";" S DR=DR_".02///M"
; AUTO REMINDERS PARAMETER
S:$G(DR)'="" DR=DR_";" S DR=DR_".03///30"
; purge days
S:$G(DR)'="" DR=DR_";" S DR=DR_".04///220"
; default subscripts to send to NTRT
S:$G(DR)'="" DR=DR_";" S DR=DR_".07///1"
; send to NTRT
S:$G(DR)'="" DR=DR_";" S DR=DR_".1///0"
; highest lab ien as of patch install
I +$P($G(^LAB(66.4,LRNT,0)),"^",6)<1 D ;<
. S A=$G(^LAB(60,0)),B=$P(A,U,3) I B+0>0 S:$G(DR)'="" DR=DR_";" S DR=DR_".06///"_B
S DA=LRNT,DIE="^LAB(66.4,"
D ^DIE S DR=""
;isaac web address
S A="vaauscttweb80.aac.domain.ext"
S:$G(DR)'="" DR=DR_";" S DR=DR_"4///"_A
; isaac port number
S:$G(DR)'="" DR=DR_";" S DR=DR_"5///8080"
;isaac NTRT path
S A="isaac-rest~rest~1~request~termRequest"
S:$G(DR)'="" DR=DR_";" S DR=DR_"6///"_A
;isaac schema name
S A="MASTER-NTRT-RECEIVE_1.XSD"
S:$G(DR)'="" DR=DR_";" S DR=DR_"7///"_A
;isaac schema path
S:$G(DR)'="" DR=DR_";" S DR=DR_"8///@"
; Save Data
;
S DA=LRNT,DIE="^LAB(66.4,"
D ^DIE
; since the site lab server is un-editable have to do a physical set
S ^LAB(66.4,DA,3)=$G(LRMS)
;
G LOUT
Q
;
LOUT W !,*7," 66.4 UPDATED"
; do post HDI seeding from here
D HDIS
;
DONE ; final quit
I $D(ZTQUEUED) S ZTREQ="@"
K WB,E,X,WE,AA,A,B,C,DA,DIC,D,DIE,LRM,LRMS,LRN,LRNT,DR,Y
Q
;
CALL ; from task manager
N ZTDESC,ZTSAVE,ZTRTN
S ZTDESC="LR NTRT POPULATE MANAGED ITEMS"
S ZTSAVE("LR*")="",ZTRTN="EN^LR664L"
D ^%ZTLOAD
K ZTDESC,ZTSAVE,ZTRTN
Q
;
HDIS ; do HDIS 'seeding'
N DOMPTR,TMP,DOMAIN,FIL,HDIMSG,MSG,A,B,C
; first check if 66.3 file has a .01 field
S A=0,A=$O(^LRMLTF(A)) I 'A D ;<
. N INS,DIC,DA,XUMF,NITM
. S INS="PEANUT IGE RAST^PEANUT IGE^SODIUM^POTASSIUM^GLUCOSE^CREATININE^CREATININE, TIMED URINE^CREATININE RATE, TIMED URINE^WBC #, BLOOD^RBC #, BLOOD^RBC #, CSF^RBC #, BODY FLUID^GLUCOSE, BODY FLUID^FSH^OCCULT BLOOD QL, STOOL^APTT^INR, BLOOD"
. F NITM=1:1:23 S X=$P(INS,U,NITM) S DIC="^LRMLTF(",DIC(0)="F",XUMF=1 D FILE^DICN
. K INS,DIC,DA,XUMF,NITM
;
; check if process has already been done
S DOMAIN="LABORATORY",FIL=66.3
S A=$P($$GETSTAT^HDISVF01(FIL),U) I A S MSG="File: "_FIL_" Has already been seeded. Status is: "_A D PSTHALT(MSG) Q
;
S TMP=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
I '+DOMPTR D MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain."),PSTHALT("") Q
D EN^HDISVCMR(DOMPTR,FIL)
K DOMPTR,TMP,DOMAIN,FIL,HDIMSG,A,B,C
Q
;
PSTHALT(MSG) ; display error message
S HDIMSG(1)=""
S HDIMSG(2)=MSG
S HDIMSG(3)="***** Post-installation of Patch LR*5.2*468 HDIS 'seeding' has been halted."
S HDIMSG(4)="***** Please contact Enterprise VistA Support."
S HDIMSG(5)=""
D MES^XPDUTL(.HDIMSG)
Q
;
;
TGET N AA,A S AA=$T(@WB),A=$P(AA,";;",2) I $E(A,1)="S" X A
K AA,A Q
402 ;;S LRM="G.LMI@TOGUS.DOMAIN.EXT"
436 ;;S LRM="G.LMI@MONTANA.DOMAIN.EXT"
438 ;;S LRM="G.LMI@SIOUX-FALLS.DOMAIN.EXT"
508 ;;S LRM="G.LMI@ATLANTA.DOMAIN.EXT"
518 ;;S LRM="G.LMI@BEDFORD.DOMAIN.EXT"
520 ;;S LRM="G.LMI@BILOXI.DOMAIN.EXT"
521 ;;S LRM="G.LMI@BIRMINGHAM.DOMAIN.EXT"
523 ;;S LRM="G.LMI@BOSTON.DOMAIN.EXT"
529 ;;S LRM="G.LMI@BUTLER.DOMAIN.EXT"
538 ;;S LRM="G.LMI@CHILLICOTHE.DOMAIN.EXT"
540 ;;S LRM="G.LMI@CLARKSBURG.DOMAIN.EXT"
541 ;;S LRM="G.LMI@CLEVELAND.DOMAIN.EXT"
546 ;;S LRM="G.LMI@MIAMI.DOMAIN.EXT"
550 ;;S LRM="G.LMI@DANVILLE.DOMAIN.EXT"
552 ;;S LRM="G.LMI@DAYTON.DOMAIN.EXT"
554 ;;S LRM="G.LMI@DENVER.DOMAIN.EXT"
568 ;;S LRM="G.LMI@BLACK-HILLS.DOMAIN.EXT"
570 ;;S LRM="G.LMI@FRESNO.DOMAIN.EXT"
573 ;;S LRM="G.LMI@NORTH-FLORIDA.DOMAIN.EXT"
575 ;;S LRM="G.LMI@GRAND-JUNCT.DOMAIN.EXT"
589 ;;S LRM="G.LMI@KANSAS-CITY.DOMAIN.EXT"
590 ;;S LRM="G.LMI@HAMPTON.DOMAIN.EXT"
596 ;;S LRM="G.LMI@LEXINGTON.DOMAIN.EXT"
600 ;;S LRM="G.LMI@LONG-BEACH.DOMAIN.EXT"
607 ;;S LRM="G.LMI@MADISON.DOMAIN.EXT"
610 ;;S LRM="G.LMI@NORTHERN-INDIANA.DOMAIN.EXT"
612 ;;S LRM="G.LMI@MARTINEZ.DOMAIN.EXT"
619 ;;S LRM="G.LMI@CENTRAL-ALABAMA.DOMAIN.EXT"
626 ;;S LRM="G.LMI@TENNESSEEVALLEY.DOMAIN.EXT"
629 ;;S LRM="G.LMI@NEW-ORLEANS.DOMAIN.EXT"
631 ;;S LRM="G.LMI@NORTHAMPTON.DOMAIN.EXT"
637 ;;S LRM="G.LMI@ASHEVILLE.DOMAIN.EXT"
642 ;;S LRM="G.LMI@PHILADELPHIA.DOMAIN.EXT"
644 ;;S LRM="G.LMI@PHOENIX.DOMAIN.EXT"
646 ;;S LRM="G.LMI@PITTSBURGH.DOMAIN.EXT"
649 ;;S LRM="G.LMI@PRESCOTT.DOMAIN.EXT"
650 ;;S LRM="G.LMI@PROVIDENCE.DOMAIN.EXT"
657 ;;S LRM="G.LMI@ST-LOUIS.DOMAIN.EXT"
658 ;;S LRM="G.LMI@SALEM.DOMAIN.EXT"
662 ;;S LRM="G.LMI@SANFRANCISCO.DOMAIN.EXT"
667 ;;S LRM="G.LMI@SHREVEPORT.DOMAIN.EXT"
671 ;;S LRM="G.LMI@SAN-ANTONIO.DOMAIN.EXT"
672 ;;S LRM="G.LMI@SAN-JUAN.DOMAIN.EXT"
675 ;;S LRM="G.LMI@ORLANDO.DOMAIN.EXT"
676 ;;S LRM="G.LMI@TOMAH.DOMAIN.EXT"
678 ;;S LRM="G.LMI@TUCSON.DOMAIN.EXT"
687 ;;S LRM="G.LMI@WALLA-WALLA.DOMAIN.EXT"
405 ;;S LRM="G.LMI@WHITE-RIVER.DOMAIN.EXT"
442 ;;S LRM="G.LMI@CHEYENNE.DOMAIN.EXT"
459 ;;S LRM="G.LMI@HONOLULU.DOMAIN.EXT"
537 ;;S LRM="G.LMI@CHICAGO-WEST.DOMAIN.EXT"
583 ;;S LRM="G.LMI@INDIANAPOLIS.DOMAIN.EXT"
636 ;;S LRM="G.LMI@CENTRAL-PLAINS.DOMAIN.EXT"
648 ;;S LRM="G.LMI@PORTLAND.DOMAIN.EXT"
655 ;;S LRM="G.LMI@SAGINAW.DOMAIN.EXT"
664 ;;S LRM="G.LMI@SAN-DIEGO.DOMAIN.EXT"
668 ;;S LRM="G.LMI@SPOKANE.DOMAIN.EXT"
679 ;;S LRM="G.LMI@TUSCALOOSA.DOMAIN.EXT"
740 ;;S LRM="G.LMI@VALLEYCOASTALBEND.DOMAIN.EXT"
437 ;;S LRM="G.LMI@FARGO.DOMAIN.EXT"
509 ;;S LRM="G.LMI@AUGUSTA.DOMAIN.EXT"
564 ;;S LRM="G.LMI@FAYETTVL-AR.DOMAIN.EXT"
598 ;;S LRM="G.LMI@LITTLE-ROCK.DOMAIN.EXT"
603 ;;S LRM="G.LMI@LOUISVILLE.DOMAIN.EXT"
659 ;;S LRM="G.LMI@SALISBURY.DOMAIN.EXT"
663 ;;S LRM="G.LMI@PUGET-SOUND.DOMAIN.EXT"
504 ;;S LRM="G.LMI@AMARILLO.DOMAIN.EXT"
512 ;;S LRM="G.LMI@BALTIMORE.DOMAIN.EXT"
515 ;;S LRM="G.LMI@BATTLE-CREEK.DOMAIN.EXT"
548 ;;S LRM="G.LMI@WEST-PALM.DOMAIN.EXT"
586 ;;S LRM="G.LMI@JACKSON.DOMAIN.EXT"
674 ;;S LRM="G.LMI@CENTRAL-TEXAS.DOMAIN.EXT"
553 ;;S LRM="G.LMI@DETROIT.DOMAIN.EXT"
578 ;;S LRM="G.LMI@HINES.DOMAIN.EXT"
581 ;;S LRM="G.LMI@HUNTINGTON.DOMAIN.EXT"
593 ;;S LRM="G.LMI@LAS-VEGAS.DOMAIN.EXT"
673 ;;S LRM="G.LMI@TAMPA.DOMAIN.EXT"
757 ;;S LRM="G.LMI@COLUMBUS.DOMAIN.EXT"
358 ;;S LRM="G.LMI@MANILA.DOMAIN.EXT"
516 ;;S LRM="G.LMI@BAY-PINES.DOMAIN.EXT"
654 ;;S LRM="G.LMI@RENO.DOMAIN.EXT"
501 ;;S LRM="G.LMI@ALBUQUERQUE.DOMAIN.EXT"
519 ;;S LRM="G.LMI@BIG-SPRING.DOMAIN.EXT"
534 ;;S LRM="G.LMI@CHARLESTON.DOMAIN.EXT"
556 ;;S LRM="G.LMI@N-CHICAGO.DOMAIN.EXT"
557 ;;S LRM="G.LMI@DUBLIN.DOMAIN.EXT"
605 ;;S LRM="G.LMI@LOMA-LINDA.DOMAIN.EXT"
562 ;;S LRM="G.LMI@ERIE.DOMAIN.EXT"
580 ;;S LRM="G.LMI@HOUSTON.DOMAIN.EXT"
608 ;;S LRM="G.LMI@MANCHESTER.DOMAIN.EXT"
652 ;;S LRM="G.LMI@RICHMOND.DOMAIN.EXT"
653 ;;S LRM="G.LMI@ROSEBURG.DOMAIN.EXT"
460 ;;S LRM="G.LMI@WILMINGTON.DOMAIN.EXT"
620 ;;S LRM="G.LMI@MONTROSE.DOMAIN.EXT"
621 ;;S LRM="G.LMI@MTN-HOME.DOMAIN.EXT"
630 ;;S LRM="G.LMI@NY-HARBOR.DOMAIN.EXT"
506 ;;S LRM="G.LMI@ANN-ARBOR.DOMAIN.EXT"
463 ;;S LRM="G.LMI@ANCHORAGE.DOMAIN.EXT"
526 ;;S LRM="G.LMI@BRONX.DOMAIN.EXT"
539 ;;S LRM="G.LMI@CINCINNATI.DOMAIN.EXT"
618 ;;S LRM="G.LMI@MINNEAPOLIS.DOMAIN.EXT"
692 ;;S LRM="G.LMI@WHITE-CITY.DOMAIN.EXT"
502 ;;S LRM="G.LMI@ALEXANDRIA.DOMAIN.EXT"
585 ;;S LRM="G.LMI@IRON-MTN.DOMAIN.EXT"
666 ;;S LRM="G.LMI@SHERIDAN.DOMAIN.EXT"
693 ;;S LRM="G.LMI@WILKES-BARRE.DOMAIN.EXT"
756 ;;S LRM="G.LMI@EL-PASO.DOMAIN.EXT"
613 ;;S LRM="G.LMI@MARTINSBURG.DOMAIN.EXT"
623 ;;S LRM="G.LMI@MUSKOGEE.DOMAIN.EXT"
632 ;;S LRM="G.LMI@NORTHPORT.DOMAIN.EXT"
660 ;;S LRM="G.LMI@SALT-LAKE.DOMAIN.EXT"
544 ;;S LRM="G.LMI@COLUMBIA-SC.DOMAIN.EXT"
549 ;;S LRM="G.LMI@DALLAS.DOMAIN.EXT"
565 ;;S LRM="G.LMI@FAYETTVL-NC.DOMAIN.EXT"
503 ;;S LRM="G.LMI@ALTOONA.DOMAIN.EXT"
640 ;;S LRM="G.LMI@PALO-ALTO.DOMAIN.EXT"
595 ;;S LRM="G.LMI@LEBANON.DOMAIN.EXT"
558 ;;S LRM="G.LMI@DURHAM.DOMAIN.EXT"
688 ;;S LRM="G.LMI@WASHINGTON.DOMAIN.EXT"
614 ;;S LRM="G.LMI@MEMPHIS.DOMAIN.EXT"
542 ;;S LRM="G.LMI@COATESVILLE.DOMAIN.EXT"
691 ;;S LRM="G.LMI@WEST-LA.DOMAIN.EXT"
531 ;;S LRM="G.LMI@BOISE.DOMAIN.EXT"
528 ;;S LRM="G.LMI@V02.DOMAIN.EXT"
695 ;;S LRM="G.LMI@MILWAUKEE.DOMAIN.EXT"
517 ;;S LRM="G.LMI@BECKLEY.DOMAIN.EXT"
561 ;;S LRM="G.LMI@EAST-ORANGE.DOMAIN.EXT"
689 ;;S LRM="G.LMI@WEST-HAVEN.DOMAIN.EXT"
635 ;;S LRM="G.LMI@OKLAHOMA.DOMAIN.EXT"
656 ;;S LRM="G.LMI@ST-CLOUD.DOMAIN.EXT"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR664L 10440 printed Apr 09, 2024@21:11:32 Page 2
LR664L ; BPFO/DTG - LAB LOAD OF ^LAB FILE 66.4 FROM PATCH LR*5.2*468 ;02/10/2016
+1 ;;5.2;LAB SERVICE;**468**;FEB 10 2016;Build 64
+2 ;
+3 ; Adding in POST call to initiate 66.3 file seeding from HDI
+4 ;
+5 ; This routine uses the following IA's:
+6 ; #4640 - ^HDISVF01 calls (supported)
+7 ; #4639 - ^HDISVCMR calls (supported)
+8 ; #4651 - ^HDISVF09 calls (supported)
+9 ;
EN ;
+1 NEW WB,E,X,WE,AA,A,B,C,DA,DIC,D,DIE,LRM,LRMS,LRN,LRNT,DR,Y
+2 SET U="^"
IF $GET(DT)=""
SET DT=$$DT^XLFDT
+3 SET WB=$$SITE^VASITE
SET WB=$PIECE(WB,U,1)
+4 IF (+WB)<1
WRITE !,*7," DEFAULT INSTITUTION NOT SET. UPDATE NOT RUN"
GOTO DONE
+5 ;S D=$$GET1^DIQ(4,WB_",",.01,"I")
+6 ;I D="" W !,*7," DEFAULT INSTITUTION NOT FOUND IN FILE 4. UPDATE NOT RUN" G DONE
+7 SET E=$ORDER(^LAB(66.4,"B",WB,0))
+8 IF E'=""
SET WE=$$NS^XUAF4(WB)
SET X=$PIECE(WE,U,1)
SET DIC="^LAB(66.4,"
SET DIC(0)="B"
DO ^DIC
if (+Y>0)
GOTO ENA
WRITE !,*7," NOT FOUND"
GOTO DONE
+9 SET X=WB
SET DIC="^LAB(66.4,"
SET DIC(0)="L"
DO FILE^DICN
+10 IF '$PIECE(Y,U,3)
WRITE !,*7,"NOT ABLE TO CREATE RECORD FOR ",D
GOTO DONE
ENA ; come here to file update
+1 SET (DA,LRNT)=+Y
SET DR=""
+2 ; DOMAIN for site e-mail group
+3 SET LRM=""
+4 IF ",402,436,438,508,518,520,521,523,529,538,540,541,546,550,552,554,568,570,573,575,589,590,596,600,607,610,612,619,626,629,631,637,642,644,646,649,650,657,658,662,667,671,672,675,676,678,687,405,442,459,537,583,"[","_WB_","
DO TGET
GOTO TDONE
+5 IF ",636,648,655,664,668,679,740,437,509,564,598,603,659,663,504,512,515,548,586,674,553,578,581,593,673,757,358,516,654,501,519,534,556,557,605,562,580,608,652,653,460,620,621,630,506,463,526,539,618,692,502,585,"[","_WB_","
DO TGET
GOTO TDONE
+6 IF ",666,693,756,613,623,632,660,544,549,565,503,640,595,558,688,614,542,691,531,528,695,517,561,689,635,656,"[","_WB_","
DO TGET
GOTO TDONE
TDONE IF LRM'=""
SET LRMS="S.LRLABSERVER@"_$PIECE(LRM,"@",2)
SET DR="2///"_LRM_";3///"_LRMS
GOTO NMAIL
+1 SET A=$$SITE^VASITE
IF A=""
GOTO NMAIL
+2 SET C=$$KSP^XUPARAM("WHERE")
IF C=""
GOTO NMAIL
+3 ; S LRM="G.LMI@"_C,LRMS="S.LRLABSERVER@"_C,DR="2///"_LRM_";3///"_LRMS
+4 SET LRM="G.LMI@"_C
SET LRMS="S.LRLABSERVER@"_C
SET DR="2///"_LRM
+5 GOTO NMAIL
+6 ;
+7 ; ntrt group mail address
NMAIL SET LRN="G.LABORATORY NTRT@DOMAIN.EXT"
+1 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_"1///"_LRN
+2 ;ISAAC ACTIVE
+3 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".05///N"
+4 ;SEND METHOD
+5 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".02///M"
+6 ; AUTO REMINDERS PARAMETER
+7 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".03///30"
+8 ; purge days
+9 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".04///220"
+10 ; default subscripts to send to NTRT
+11 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".07///1"
+12 ; send to NTRT
+13 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".1///0"
+14 ; highest lab ien as of patch install
+15 ;<
IF +$PIECE($GET(^LAB(66.4,LRNT,0)),"^",6)<1
Begin DoDot:1
+16 SET A=$GET(^LAB(60,0))
SET B=$PIECE(A,U,3)
IF B+0>0
if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_".06///"_B
End DoDot:1
+17 SET DA=LRNT
SET DIE="^LAB(66.4,"
+18 DO ^DIE
SET DR=""
+19 ;isaac web address
+20 SET A="vaauscttweb80.aac.domain.ext"
+21 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_"4///"_A
+22 ; isaac port number
+23 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_"5///8080"
+24 ;isaac NTRT path
+25 SET A="isaac-rest~rest~1~request~termRequest"
+26 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_"6///"_A
+27 ;isaac schema name
+28 SET A="MASTER-NTRT-RECEIVE_1.XSD"
+29 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_"7///"_A
+30 ;isaac schema path
+31 if $GET(DR)'=""
SET DR=DR_";"
SET DR=DR_"8///@"
+32 ; Save Data
+33 ;
+34 SET DA=LRNT
SET DIE="^LAB(66.4,"
+35 DO ^DIE
+36 ; since the site lab server is un-editable have to do a physical set
+37 SET ^LAB(66.4,DA,3)=$GET(LRMS)
+38 ;
+39 GOTO LOUT
+40 QUIT
+41 ;
LOUT WRITE !,*7," 66.4 UPDATED"
+1 ; do post HDI seeding from here
+2 DO HDIS
+3 ;
DONE ; final quit
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL WB,E,X,WE,AA,A,B,C,DA,DIC,D,DIE,LRM,LRMS,LRN,LRNT,DR,Y
+3 QUIT
+4 ;
CALL ; from task manager
+1 NEW ZTDESC,ZTSAVE,ZTRTN
+2 SET ZTDESC="LR NTRT POPULATE MANAGED ITEMS"
+3 SET ZTSAVE("LR*")=""
SET ZTRTN="EN^LR664L"
+4 DO ^%ZTLOAD
+5 KILL ZTDESC,ZTSAVE,ZTRTN
+6 QUIT
+7 ;
HDIS ; do HDIS 'seeding'
+1 NEW DOMPTR,TMP,DOMAIN,FIL,HDIMSG,MSG,A,B,C
+2 ; first check if 66.3 file has a .01 field
+3 ;<
SET A=0
SET A=$ORDER(^LRMLTF(A))
IF 'A
Begin DoDot:1
+4 NEW INS,DIC,DA,XUMF,NITM
+5 SET INS="PEANUT IGE RAST^PEANUT IGE^SODIUM^POTASSIUM^GLUCOSE^CREATININE^CREATININE, TIMED URINE^CREATININE RATE, TIMED URINE^WBC #, BLOOD^RBC #, BLOOD^RBC #, CSF^RBC #, BODY FLUID^GLUCOSE, BODY FLUID^FSH^OCCULT BLOOD QL, STOOL^APTT^INR,
BLOOD"
+6 FOR NITM=1:1:23
SET X=$PIECE(INS,U,NITM)
SET DIC="^LRMLTF("
SET DIC(0)="F"
SET XUMF=1
DO FILE^DICN
+7 KILL INS,DIC,DA,XUMF,NITM
End DoDot:1
+8 ;
+9 ; check if process has already been done
+10 SET DOMAIN="LABORATORY"
SET FIL=66.3
+11 SET A=$PIECE($$GETSTAT^HDISVF01(FIL),U)
IF A
SET MSG="File: "_FIL_" Has already been seeded. Status is: "_A
DO PSTHALT(MSG)
QUIT
+12 ;
+13 SET TMP=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
+14 IF '+DOMPTR
DO MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain.")
DO PSTHALT("")
QUIT
+15 DO EN^HDISVCMR(DOMPTR,FIL)
+16 KILL DOMPTR,TMP,DOMAIN,FIL,HDIMSG,A,B,C
+17 QUIT
+18 ;
PSTHALT(MSG) ; display error message
+1 SET HDIMSG(1)=""
+2 SET HDIMSG(2)=MSG
+3 SET HDIMSG(3)="***** Post-installation of Patch LR*5.2*468 HDIS 'seeding' has been halted."
+4 SET HDIMSG(4)="***** Please contact Enterprise VistA Support."
+5 SET HDIMSG(5)=""
+6 DO MES^XPDUTL(.HDIMSG)
+7 QUIT
+8 ;
+9 ;
TGET NEW AA,A
SET AA=$TEXT(@WB)
SET A=$PIECE(AA,";;",2)
IF $EXTRACT(A,1)="S"
XECUTE A
+1 KILL AA,A
QUIT
402 ;;S LRM="G.LMI@TOGUS.DOMAIN.EXT"
436 ;;S LRM="G.LMI@MONTANA.DOMAIN.EXT"
438 ;;S LRM="G.LMI@SIOUX-FALLS.DOMAIN.EXT"
508 ;;S LRM="G.LMI@ATLANTA.DOMAIN.EXT"
518 ;;S LRM="G.LMI@BEDFORD.DOMAIN.EXT"
520 ;;S LRM="G.LMI@BILOXI.DOMAIN.EXT"
521 ;;S LRM="G.LMI@BIRMINGHAM.DOMAIN.EXT"
523 ;;S LRM="G.LMI@BOSTON.DOMAIN.EXT"
529 ;;S LRM="G.LMI@BUTLER.DOMAIN.EXT"
538 ;;S LRM="G.LMI@CHILLICOTHE.DOMAIN.EXT"
540 ;;S LRM="G.LMI@CLARKSBURG.DOMAIN.EXT"
541 ;;S LRM="G.LMI@CLEVELAND.DOMAIN.EXT"
546 ;;S LRM="G.LMI@MIAMI.DOMAIN.EXT"
550 ;;S LRM="G.LMI@DANVILLE.DOMAIN.EXT"
552 ;;S LRM="G.LMI@DAYTON.DOMAIN.EXT"
554 ;;S LRM="G.LMI@DENVER.DOMAIN.EXT"
568 ;;S LRM="G.LMI@BLACK-HILLS.DOMAIN.EXT"
570 ;;S LRM="G.LMI@FRESNO.DOMAIN.EXT"
573 ;;S LRM="G.LMI@NORTH-FLORIDA.DOMAIN.EXT"
575 ;;S LRM="G.LMI@GRAND-JUNCT.DOMAIN.EXT"
589 ;;S LRM="G.LMI@KANSAS-CITY.DOMAIN.EXT"
590 ;;S LRM="G.LMI@HAMPTON.DOMAIN.EXT"
596 ;;S LRM="G.LMI@LEXINGTON.DOMAIN.EXT"
600 ;;S LRM="G.LMI@LONG-BEACH.DOMAIN.EXT"
607 ;;S LRM="G.LMI@MADISON.DOMAIN.EXT"
610 ;;S LRM="G.LMI@NORTHERN-INDIANA.DOMAIN.EXT"
612 ;;S LRM="G.LMI@MARTINEZ.DOMAIN.EXT"
619 ;;S LRM="G.LMI@CENTRAL-ALABAMA.DOMAIN.EXT"
626 ;;S LRM="G.LMI@TENNESSEEVALLEY.DOMAIN.EXT"
629 ;;S LRM="G.LMI@NEW-ORLEANS.DOMAIN.EXT"
631 ;;S LRM="G.LMI@NORTHAMPTON.DOMAIN.EXT"
637 ;;S LRM="G.LMI@ASHEVILLE.DOMAIN.EXT"
642 ;;S LRM="G.LMI@PHILADELPHIA.DOMAIN.EXT"
644 ;;S LRM="G.LMI@PHOENIX.DOMAIN.EXT"
646 ;;S LRM="G.LMI@PITTSBURGH.DOMAIN.EXT"
649 ;;S LRM="G.LMI@PRESCOTT.DOMAIN.EXT"
650 ;;S LRM="G.LMI@PROVIDENCE.DOMAIN.EXT"
657 ;;S LRM="G.LMI@ST-LOUIS.DOMAIN.EXT"
658 ;;S LRM="G.LMI@SALEM.DOMAIN.EXT"
662 ;;S LRM="G.LMI@SANFRANCISCO.DOMAIN.EXT"
667 ;;S LRM="G.LMI@SHREVEPORT.DOMAIN.EXT"
671 ;;S LRM="G.LMI@SAN-ANTONIO.DOMAIN.EXT"
672 ;;S LRM="G.LMI@SAN-JUAN.DOMAIN.EXT"
675 ;;S LRM="G.LMI@ORLANDO.DOMAIN.EXT"
676 ;;S LRM="G.LMI@TOMAH.DOMAIN.EXT"
678 ;;S LRM="G.LMI@TUCSON.DOMAIN.EXT"
687 ;;S LRM="G.LMI@WALLA-WALLA.DOMAIN.EXT"
405 ;;S LRM="G.LMI@WHITE-RIVER.DOMAIN.EXT"
442 ;;S LRM="G.LMI@CHEYENNE.DOMAIN.EXT"
459 ;;S LRM="G.LMI@HONOLULU.DOMAIN.EXT"
537 ;;S LRM="G.LMI@CHICAGO-WEST.DOMAIN.EXT"
583 ;;S LRM="G.LMI@INDIANAPOLIS.DOMAIN.EXT"
636 ;;S LRM="G.LMI@CENTRAL-PLAINS.DOMAIN.EXT"
648 ;;S LRM="G.LMI@PORTLAND.DOMAIN.EXT"
655 ;;S LRM="G.LMI@SAGINAW.DOMAIN.EXT"
664 ;;S LRM="G.LMI@SAN-DIEGO.DOMAIN.EXT"
668 ;;S LRM="G.LMI@SPOKANE.DOMAIN.EXT"
679 ;;S LRM="G.LMI@TUSCALOOSA.DOMAIN.EXT"
740 ;;S LRM="G.LMI@VALLEYCOASTALBEND.DOMAIN.EXT"
437 ;;S LRM="G.LMI@FARGO.DOMAIN.EXT"
509 ;;S LRM="G.LMI@AUGUSTA.DOMAIN.EXT"
564 ;;S LRM="G.LMI@FAYETTVL-AR.DOMAIN.EXT"
598 ;;S LRM="G.LMI@LITTLE-ROCK.DOMAIN.EXT"
603 ;;S LRM="G.LMI@LOUISVILLE.DOMAIN.EXT"
659 ;;S LRM="G.LMI@SALISBURY.DOMAIN.EXT"
663 ;;S LRM="G.LMI@PUGET-SOUND.DOMAIN.EXT"
504 ;;S LRM="G.LMI@AMARILLO.DOMAIN.EXT"
512 ;;S LRM="G.LMI@BALTIMORE.DOMAIN.EXT"
515 ;;S LRM="G.LMI@BATTLE-CREEK.DOMAIN.EXT"
548 ;;S LRM="G.LMI@WEST-PALM.DOMAIN.EXT"
586 ;;S LRM="G.LMI@JACKSON.DOMAIN.EXT"
674 ;;S LRM="G.LMI@CENTRAL-TEXAS.DOMAIN.EXT"
553 ;;S LRM="G.LMI@DETROIT.DOMAIN.EXT"
578 ;;S LRM="G.LMI@HINES.DOMAIN.EXT"
581 ;;S LRM="G.LMI@HUNTINGTON.DOMAIN.EXT"
593 ;;S LRM="G.LMI@LAS-VEGAS.DOMAIN.EXT"
673 ;;S LRM="G.LMI@TAMPA.DOMAIN.EXT"
757 ;;S LRM="G.LMI@COLUMBUS.DOMAIN.EXT"
358 ;;S LRM="G.LMI@MANILA.DOMAIN.EXT"
516 ;;S LRM="G.LMI@BAY-PINES.DOMAIN.EXT"
654 ;;S LRM="G.LMI@RENO.DOMAIN.EXT"
501 ;;S LRM="G.LMI@ALBUQUERQUE.DOMAIN.EXT"
519 ;;S LRM="G.LMI@BIG-SPRING.DOMAIN.EXT"
534 ;;S LRM="G.LMI@CHARLESTON.DOMAIN.EXT"
556 ;;S LRM="G.LMI@N-CHICAGO.DOMAIN.EXT"
557 ;;S LRM="G.LMI@DUBLIN.DOMAIN.EXT"
605 ;;S LRM="G.LMI@LOMA-LINDA.DOMAIN.EXT"
562 ;;S LRM="G.LMI@ERIE.DOMAIN.EXT"
580 ;;S LRM="G.LMI@HOUSTON.DOMAIN.EXT"
608 ;;S LRM="G.LMI@MANCHESTER.DOMAIN.EXT"
652 ;;S LRM="G.LMI@RICHMOND.DOMAIN.EXT"
653 ;;S LRM="G.LMI@ROSEBURG.DOMAIN.EXT"
460 ;;S LRM="G.LMI@WILMINGTON.DOMAIN.EXT"
620 ;;S LRM="G.LMI@MONTROSE.DOMAIN.EXT"
621 ;;S LRM="G.LMI@MTN-HOME.DOMAIN.EXT"
630 ;;S LRM="G.LMI@NY-HARBOR.DOMAIN.EXT"
506 ;;S LRM="G.LMI@ANN-ARBOR.DOMAIN.EXT"
463 ;;S LRM="G.LMI@ANCHORAGE.DOMAIN.EXT"
526 ;;S LRM="G.LMI@BRONX.DOMAIN.EXT"
539 ;;S LRM="G.LMI@CINCINNATI.DOMAIN.EXT"
618 ;;S LRM="G.LMI@MINNEAPOLIS.DOMAIN.EXT"
692 ;;S LRM="G.LMI@WHITE-CITY.DOMAIN.EXT"
502 ;;S LRM="G.LMI@ALEXANDRIA.DOMAIN.EXT"
585 ;;S LRM="G.LMI@IRON-MTN.DOMAIN.EXT"
666 ;;S LRM="G.LMI@SHERIDAN.DOMAIN.EXT"
693 ;;S LRM="G.LMI@WILKES-BARRE.DOMAIN.EXT"
756 ;;S LRM="G.LMI@EL-PASO.DOMAIN.EXT"
613 ;;S LRM="G.LMI@MARTINSBURG.DOMAIN.EXT"
623 ;;S LRM="G.LMI@MUSKOGEE.DOMAIN.EXT"
632 ;;S LRM="G.LMI@NORTHPORT.DOMAIN.EXT"
660 ;;S LRM="G.LMI@SALT-LAKE.DOMAIN.EXT"
544 ;;S LRM="G.LMI@COLUMBIA-SC.DOMAIN.EXT"
549 ;;S LRM="G.LMI@DALLAS.DOMAIN.EXT"
565 ;;S LRM="G.LMI@FAYETTVL-NC.DOMAIN.EXT"
503 ;;S LRM="G.LMI@ALTOONA.DOMAIN.EXT"
640 ;;S LRM="G.LMI@PALO-ALTO.DOMAIN.EXT"
595 ;;S LRM="G.LMI@LEBANON.DOMAIN.EXT"
558 ;;S LRM="G.LMI@DURHAM.DOMAIN.EXT"
688 ;;S LRM="G.LMI@WASHINGTON.DOMAIN.EXT"
614 ;;S LRM="G.LMI@MEMPHIS.DOMAIN.EXT"
542 ;;S LRM="G.LMI@COATESVILLE.DOMAIN.EXT"
691 ;;S LRM="G.LMI@WEST-LA.DOMAIN.EXT"
531 ;;S LRM="G.LMI@BOISE.DOMAIN.EXT"
528 ;;S LRM="G.LMI@V02.DOMAIN.EXT"
695 ;;S LRM="G.LMI@MILWAUKEE.DOMAIN.EXT"
517 ;;S LRM="G.LMI@BECKLEY.DOMAIN.EXT"
561 ;;S LRM="G.LMI@EAST-ORANGE.DOMAIN.EXT"
689 ;;S LRM="G.LMI@WEST-HAVEN.DOMAIN.EXT"
635 ;;S LRM="G.LMI@OKLAHOMA.DOMAIN.EXT"
656 ;;S LRM="G.LMI@ST-CLOUD.DOMAIN.EXT"
