246 lines
7.9 KiB
Mathematica
246 lines
7.9 KiB
Mathematica
LR334PO ;DALOI/FHS/RSH - LR*5.2*334 PATCH POST INSTALL ROUTINE;31-AUG-2001
|
|
;;5.2;LAB SERVICE;**334**;Sep 27, 1994;Build 12
|
|
PRE ;
|
|
;$$HTE^XLFDT supported by DBIA #10103
|
|
;$$HTFE^XLFDT supported by DBIA #10103
|
|
;$$NOW^XLFDT supported by DBIA #10103
|
|
;$$CJ^XLFSTR supported by DBIA #10104
|
|
;^XMD supported by DBIA #10070
|
|
;$$PATCH^XPDUTL supported by DBIA #10141
|
|
;BMES^XPDUTL supported by DBIA #10141
|
|
;SETUP^XQALERT supported by DBIA $10081
|
|
;FILE^DIE supported by DBIA #10018
|
|
;GETS^DIQ supported by DBIA #2056
|
|
;EN^DIU2 supported by DBIA #10014
|
|
;$$SITE^VASITE supported by DBIA #10112
|
|
;$$FMTE^XLFDT supported by DBIA #10103
|
|
;$$THE^XLFDT supported by DBIA #10103
|
|
;$$HTFM^XLFDT supported by DBIA #10103
|
|
Q:'$D(XPDNM)
|
|
VENDOR ;Save the vender pointer name into the VENDOR field.
|
|
N LRI,LRVEN
|
|
S LRI=0 F S LRI=$O(^LAB(64.2,LRI)) Q:LRI<1 S LRVEN=$P($G(^(LRI,0)),U,14) I LRVEN D
|
|
. S LRVEN=$P($G(^LAB(64.3,+LRVEN,0)),U)
|
|
. I $L(LRVEN) S $P(^LAB(64.2,LRI,2),U,2)=LRVEN
|
|
I '$D(^XTMP("LRNLT642")) D
|
|
. N LRLAST
|
|
. S LRLAST=$O(^LAB(64.2,99999),-1)
|
|
. S ^XTMP("LRNLT642",.01)=LRLAST
|
|
. S ^XTMP("LRNLT642",0)=$$HTFM^XLFDT($H+90,1)_"^"_DT_"^ LAB(64.2 Save"
|
|
. M ^XTMP("LRNLT642",1)=^LAB(64.2)
|
|
Q
|
|
EN1 ;Find and correct existing spelling or duplicate numbers errors.
|
|
N DA,DIC,DIK,DIU,X,Y,DIRUT,DTOUT,DUOUT
|
|
REINDEX ;Reindex LAM to fire new x-refs
|
|
L +^LAM:999 I '$T G EN1
|
|
D
|
|
. N DIK
|
|
. S DIK="^LAM(" D IXALL^DIK
|
|
. S $P(^LAM(0),U,3)=99999
|
|
K ^XTMP("LRNLTERR","LR334") S ^XTMP("LRNLTERR",0)=$$HTFM^XLFDT($H+90,1)_"^"_DT_"^LR52 334 Error Messages"
|
|
K ^XTMP("LRNLT","LR334")
|
|
S ^XTMP("LRNLT",0)=$$HTFM^XLFDT($H+90,1)_"^"_DT_"^LR52 334 Messages"
|
|
N DA,DIK,LRIEN,LRN0,LRN1,LRFILE
|
|
D POST,ALERT^LR334POA
|
|
Q
|
|
;
|
|
CHK N DIC,X,Y
|
|
K LRFDA,LRANS,LRNAMX,LRNUMX,LRNAMY,LRNUMY
|
|
S DIC(0)="ZNMO",(LRNAMX,LRNAMY,X)=$P(LRN0,U)
|
|
I $G(LRFILE)=64 D
|
|
. S DIC=64,(LRNUMY,LRNUMX)=$P(LRN0,U,2)
|
|
. S DIC("S")="I $P(^(0),U,2)=LRNUMX"
|
|
. D ^DIC I Y<1 D DEL Q
|
|
. W:$G(LRDBUG) !,Y_" ( "_LRFILE
|
|
. S LRIENS=+Y_","
|
|
. I $L($P(LRN0,U,8)) D
|
|
. . S LRNAMY=$P(LRN0,U,8)
|
|
. . S LRFDA(LRFILE,LRIENS,.01)=LRNAMY
|
|
. I $P(LRN0,U,3) D
|
|
. . S LRNUMY=$P(LRN0,U,3)
|
|
. . Q:$O(^LAM("C",LRNUMY_" ",0))
|
|
. . S LRFDA(LRFILE,LRIENS,1)=LRNUMY
|
|
I $G(LRFILE)=64.2 D
|
|
. N DIC
|
|
. S (LRNAMX,LRNAMY,X)=$P(LRN0,U)
|
|
. S DIC=64.2,LRNUMX=$P(LRN1,U,2)
|
|
. S DIC("S")="I $P(^(0),U,2)=LRNUMX"
|
|
. D ^DIC I Y<1 D DEL Q
|
|
. S LRIENS=+Y_","
|
|
. I $L($P(LRN0,U,8)) D
|
|
. . S LRNAMY=$P(LRN0,U,8)
|
|
. . S LRFDA(LRFILE,LRIENS,.01)=LRNAMY
|
|
. I $P(LRN1,U,3) D
|
|
. . S LRNUMY=$P(LRN1,U,3)
|
|
. . S LRFDA(LRFILE,LRIENS,1)=LRNUMY
|
|
. I $L($P(LRN1,U,7)) D
|
|
. . S LRSYN=$P(LRN1,U,7),LRSYNIEN=$O(^LAB(64.2,+LRIENS,1,"B",LRSYN,0))
|
|
. . Q:'LRSYNIEN
|
|
. . S LRFDA(64.23,LRSYNIEN_","_LRIENS,.01)="@"
|
|
. W:$G(LRDBUG) !,Y_" ( "_LRFILE
|
|
I $D(LRFDA) D SET
|
|
Q
|
|
SET ;
|
|
D FILE^DIE("KS","LRFDA","LRANS")
|
|
I '$D(LRANS) W:$G(LRDBUG) !,"Okay" D Q
|
|
. D WRT,DEL
|
|
Q ; EDIT ERRORS are left in ^LAB(64.81)
|
|
;
|
|
DEL ;
|
|
N DA,DIK
|
|
S DA=LRIEN,DIK="^LAB(64.81," D ^DIK
|
|
Q
|
|
ERR ;
|
|
W !,LRIEN_" ( "_LRFILE_" ERROR"
|
|
Q
|
|
WRT ;
|
|
D SCR(LRNUMX_" "_LRNAMX)
|
|
D SCR("Was changed to: "_LRNUMY_" "_LRNAMY)
|
|
Q
|
|
POST ;TRANSPORT FILE 64.81 INTO FILE 64 IF REQUIRED
|
|
N LRREC,LRREC9
|
|
K ^XTMP("LRNLT","LR334") D
|
|
. S ^XTMP("LRNLT",0)=$$HTFM^XLFDT($H+90,1)_U_DT_U_"LR334 Added NLT Codes List"
|
|
. S ^XTMP("LRNLT","LR334",0)=""
|
|
;D DSS W !
|
|
P1 F L +^LAM:10 Q:$T D BMES^LR334("Attempting to Lock ^LAM Global.")
|
|
S (LRLAST64,LRNEXT)=$O(^LAM(99999),-1)
|
|
S:LRNEXT<1 (LRLAST64,LRNEXT)=0
|
|
S $P(^LAM(0),U,3)=LRNEXT
|
|
S LRN=$O(^XTMP("LRNLT642",1,99999),-1)
|
|
S (LRADD,LRCHG,LRDOT)=0
|
|
D SCR("==========================")
|
|
D SCR("List of WKLD CODES added to ^LAM (#64)")
|
|
D SCR(" ")
|
|
S LRNEXT=0,LRIEN=50
|
|
F S LRNEXT=$O(^LAB(64.81,LRIEN,2,LRNEXT)) Q:LRNEXT<1 D
|
|
. K LRFDA,LROUT,LRAR1,LRSIXT4
|
|
. S LRDOT=$G(LRDOT)+1 I LRDOT#50=0 W ". "
|
|
. S LRREC=^LAB(64.81,LRIEN,2,LRNEXT,0),LRERR=0
|
|
. S LRREC9=+$G(^LAB(64.81,LRIEN,2,LRNEXT,9))
|
|
. I $G(LRDBUG) W !,LRREC_" "
|
|
. S LRTRIEN=$P(LRREC,U)
|
|
. I $S($P(LRREC,U,2)["~":1,$P($P(LRREC,U,3),".",2):1,1:0) D KREC Q
|
|
. D CMP
|
|
. Q:LRERR
|
|
. I LRCHG D CHGNM
|
|
. I LRADD D GNDE
|
|
. I $S($G(LROUT(42,"DIERR")):0,$G(LROUT(45,"DIERR")):0,1:1) D KREC
|
|
. K LROUT
|
|
S $P(^LAM(0),U,3)=99999
|
|
D:'$G(LRDBUG) MAIL^LR334POA
|
|
KIL K LRADD,LRANS,LRAR1,LRBEG,LRCHG,LRCNT,LRCODE,LRCTR,LRDOT,LREND
|
|
K LRENODE,LRERR,LRFDA,LRFILE,LRFLD,LRFLE,LRFNAM,LRI,LRIEN,LRIENS
|
|
K LRMLT,LRN,LRN0,LRN1,LRNAMX,LRNAMY,LRNEXT,LRNIEN,LRNODE,LRNUM
|
|
K LRNUMX,LRNUMY,LRNX,LROUT,LRPROCNM,LRREC,LRSC,LRSCR,LRSEQ,LRSIXT4
|
|
K LRSUBFLE,LRSYN,LRSYNIEN,LRTRIEN,LRVAL,LRVR,X,Y
|
|
Q
|
|
CHGNM ; CHANGE THE PROCEDURE NAME IN THE RECORD
|
|
K LRFDA
|
|
S LRFDA(42,64,LRCHG_",",.01)=LRPROCNM
|
|
D FILE^DIE("K","LRFDA(42)","LROUT(42)")
|
|
I $G(LROUT(42,"DIERR")) D
|
|
. S LRERR=1
|
|
. S LRENODE="LROUT(42,""DIERR"")"
|
|
. D ERMSG
|
|
I '$G(LROUT(42,"DIERR")) D SCR(LRCODE_"|"_LRPROCNM_"|"_"**Procedure Name Changed**")
|
|
K LRFDA(42),LRPROCNM
|
|
Q
|
|
CMP ; COMPARE FOUND CODES AND PROCEDURE NAMES
|
|
N DIC,X,Y,ANS
|
|
S (LRADD,LRCHG,LRERR)=0
|
|
S LRCODE=$P(LRREC,U,3),LRPROCNM=$P(LRREC,U,2)
|
|
S Y=+$$FIND1^DIC(64,"","XO",LRCODE_" ","C","","ANS")
|
|
I Y<1 D
|
|
. S LRADD=1,LRN=$G(LRN)+1
|
|
. D SCR(LRCODE_"|"_LRPROCNM_"|")
|
|
I Y>1,$G(LRREC9) D
|
|
. I $D(^LAM(+Y,0)),$G(^LAM(+Y,9))<1 S $P(^LAM(+Y,9),U)=LRREC9
|
|
Q
|
|
SCR(LRMSG) ;Store message in ^XTMP("LRNLT" Global
|
|
S LRSCR=$G(^XTMP("LRNLT","LR334",1,0))+1,^(0)=LRSCR
|
|
S ^XTMP("LRNLT","LR334",1,LRSCR)=LRSCR_"|"_LRMSG
|
|
Q
|
|
SETUP ; SETS UP THE FDA ARRAY TO ADD A NODE
|
|
F S LRNODE=$Q(@LRNODE) Q:LRNODE="" D
|
|
. S LRFLE=$QS(LRNODE,1)
|
|
. S LRFLD=$QS(LRNODE,3)
|
|
. I LRFLE=64.8117 D
|
|
. . S LRSUBFLE=64
|
|
. . I LRFLD=1 S LRFLD=.01
|
|
. . I LRFLD>1 S LRFLD=LRFLD-1
|
|
. . S LRIENS="+"_LRTRIEN_","
|
|
. I LRFLE'=64.8117 D
|
|
. .; CONSTRUCT THE SUBFILE NUMBER FOR FILE 64 FROM 64.81
|
|
. . S LRBEG=$P(LRFLE,"8117")
|
|
. . S LREND=$P(LRFLE,"8117",2)
|
|
. . S LRSUBFLE=LRBEG_"0"_LREND
|
|
. . I LRFLD=.01 S LRSEQ=LRSEQ+1
|
|
. . S LRIENS="+"_LRSEQ_","_"+"_LRTRIEN_","
|
|
. S LRVAL=@LRNODE
|
|
. S LRFDA(45,LRSUBFLE,LRIENS,LRFLD)=LRVAL
|
|
. ;W !,"LRFDA(45,"_LRSUBFLE_","_LRIENS_LRFLD_")="_LRVAL
|
|
K LRAR1
|
|
Q
|
|
GNDE ; RETRIEVES NODES FROM THE TRANSPORT MULTIPLE
|
|
S LRMLT="",LRCTR=1
|
|
D GETS^DIQ(64.8117,LRTRIEN_","_LRIEN_",",LRMLT_"*","INZ","LRAR1")
|
|
S LRNODE="LRAR1(64.8117_LRMLT)"
|
|
D SETUP
|
|
I $D(^LAB(64.81,50,2,LRTRIEN,1,0)) S LRNUM=$P(^LAB(64.81,50,2,LRTRIEN,1,0),U,4),LRSEQ=LRNUM+1
|
|
E I '$D(^LAB(64.81,50,2,LRTRIEN,1,0)) S LRSEQ=2
|
|
S LRMLT=18
|
|
D GETS^DIQ(64.8117,LRTRIEN_","_LRIEN_",",LRMLT_"*","INZ","LRAR1")
|
|
S LRNODE="LRAR1(64.8117_LRMLT)"
|
|
D SETUP
|
|
S LRMLT=19,LRSEQ=1
|
|
D GETS^DIQ(64.8117,LRTRIEN_","_LRIEN_",",LRMLT_"*","INZ","LRAR1")
|
|
S LRNODE="LRAR1(64.8117_LRMLT)"
|
|
D SETUP
|
|
D AREC I $G(LRDBUG) W !,"NEW IEN=",$G(LRSIXT4(LRTRIEN))
|
|
K LRSIXT4,LRFDA(45)
|
|
Q
|
|
AREC ; ADDS ENTRIES FROM THE TRANSPORT MULTIPLE TO FILE 64
|
|
D UPDATE^DIE("","LRFDA(45)","LRSIXT4","LROUT(45)")
|
|
I $G(LROUT(45,"DIERR")) D
|
|
. S LRENODE="LROUT(45,""DIERR"")"
|
|
. D ERMSG
|
|
K LRFDA(45)
|
|
Q
|
|
ERMSG ;STUFF THE TEMP GLOBAL WITH ANY ERROR MESSAGES
|
|
S LRN=$G(^XTMP("LRNLT642",1,0))+1
|
|
S ^XTMP("LRNLT642",1,LRN,0)="|"_LRTRIEN_"|"_LRCODE_"|"_LRPROCNM_"|ERR"
|
|
F S LRENODE=$Q(@LRENODE) Q:LRENODE="" D
|
|
. S LRN=LRN+1
|
|
. S ^XTMP("LRNLT642",1,LRN,0)="|"_LRENODE_"|="_@LRENODE
|
|
S ^XTMP("LRNLT642",1,0)=LRN
|
|
S LRERR=1
|
|
K LRENODE
|
|
Q
|
|
KREC ; DELETES THE RECORD FROM THE FILE
|
|
Q:$G(LRDBUG)
|
|
N DA,DIK
|
|
S DA(1)=LRIEN,DA=LRTRIEN
|
|
S DIK="^LAB(64.81,"_DA(1)_",2," D ^DIK
|
|
Q
|
|
DSS ;Update WKLD CODE file , DSS Feeder Key (#14) field to 'Yes"
|
|
;for those NLT codes used for AP professional services
|
|
D BMES^LR334("Updating DSS Feeder Key for AP NLT Codes")
|
|
N ERR,FDA,IEN,LST,OUT,NODE,X
|
|
S NODE="^LAB(64.81,""AC"")"
|
|
F S NODE=$Q(@NODE) Q:$QS(NODE,2)'="AC" D
|
|
. S X=$P($$GET1^DIQ(64.8117,$QS(NODE,5)_","_$QS(NODE,4)_",",2,"I","ERR"),".")
|
|
. Q:'X
|
|
. K OUT,ERR
|
|
. D FIND^DIC(64,"","@;1","M",X,"","C","","","OUT","ERR")
|
|
. Q:$D(ERR)
|
|
. S LST=0 F S LST=$O(OUT("DILIST",2,LST)) Q:'LST D
|
|
. . S IEN=$G(OUT("DILIST",2,LST))
|
|
. . Q:'($D(^LAM(IEN,0))#2)
|
|
. . K FDA,ERR S FDA(1,64,IEN_",",14)=1
|
|
. . D FILE^DIE("","FDA(1)","ERR")
|
|
. . I $D(ERR) W !,$C(7),ERR
|
|
. . W "*"
|
|
D BMES^LR334("Update DSS AP Feeder Key Complete")
|
|
Q
|