| [613] | 1 | LR127PO ;DALISC/FHS - LR*5.2*127 POST INSTALL ROUTINE KIDS INSTALL
|
|---|
| 2 | ;;5.2;LAB SERVICE;**127**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | STOP ;
|
|---|
| 5 | L +^LAM(0):2 I $T S:$D(^LAM(0))#2 $P(^(0),U,3)=99999 L -^LAM(0)
|
|---|
| 6 | S $P(^LAB(69.9,1,"NITE"),U,6)=""
|
|---|
| 7 | S X=$$ADD^XPDMENU("LR LIM/WKLD MENU","LR7O 60-64")
|
|---|
| 8 | W !!," 'National Laboratory File' menu was ",$S(X:"added",1:"NOT ADDED")," to [LR LIM/WKLD] Menu ",! W:'X $C(7)
|
|---|
| 9 | I '$O(^LAB(64.81,0)) W $C(7),$$CJ^XLFSTR("No data in file # 64.81 - No linking done.",80) G MSG
|
|---|
| 10 | W !!,$$CJ^XLFSTR("Starting CPT to NLT linking Standby",80),!
|
|---|
| 11 | CPT ;
|
|---|
| 12 | S LRACTDT="JULY 17,1996"
|
|---|
| 13 | K DIE S LRIEN=0,DIE="^LAM(" F S LRIEN=$O(^LAB(64.81,LRIEN)) Q:LRIEN<1 I $D(^(LRIEN,0))#2 S DATA=^(0) D I '$P(^LAB(64.81,LRIEN,0),U,9) D PURG
|
|---|
| 14 | . S LRNLT=$P(DATA,U,2),LRCPT=$P(DATA,U,3)
|
|---|
| 15 | . Q:'LRNLT!('LRCPT) W "." D LK
|
|---|
| 16 | I '$O(^LAB(64.81,0)) W !,$$CJ^XLFSTR("Database Upgrade Completed Sucessfully",80),!! G MSG
|
|---|
| 17 | W !?10," Database Upgrade Incomplete - Use FM to Print a Listing"
|
|---|
| 18 | W !,"of the LAB NLT/CPT CODES (#64.81) for a listing of errors",!!
|
|---|
| 19 | MSG S $P(^LAB(69.9,1,"VSIT"),U)=2
|
|---|
| 20 | W !,$$CJ^XLFSTR("PCE/VSIT ON (#615) field in LABORATORY SITE (#69.9) file",80)
|
|---|
| 21 | W !,$$CJ^XLFSTR("has been set to BOTH PCE/VSIT AND STOP CODES",80),!!
|
|---|
| 22 | W !,$$CJ^XLFSTR("You can use the [Edit or Print WKLD CODES] option for a printed list",80)
|
|---|
| 23 | W !,$$CJ^XLFSTR("of linked CPT linked NLT codes.",80),!
|
|---|
| 24 | W !!,$$CJ^XLFSTR("Post install completed",80),!!
|
|---|
| 25 | W !!?5," The Laboratory LIM should use the National Laboratory File"
|
|---|
| 26 | W !,"Menu [LR7O 60-64] to link Laboratory Test to WKLD CODES (#64) "
|
|---|
| 27 | W !,"This should be done before 10/1/96 to permit CPT codes to be"
|
|---|
| 28 | W !,"passed to the PCE package",!,$C(7),!
|
|---|
| 29 | END ;
|
|---|
| 30 | Q:$G(LRDBUG)
|
|---|
| 31 | K DA,DATA,DIE,DIK,DIC,DR,LRACTDT,LRCODE,LRCPT,LRIEN,LRNLT,LRNODE,TAG,X
|
|---|
| 32 | Q
|
|---|
| 33 | LK ;
|
|---|
| 34 | S LRCODE=0 F S LRCODE=+$O(^LAM("C",LRNLT_" ",LRCODE)) Q:LRCODE<1 D
|
|---|
| 35 | . K DA S TAG="*",DA=LRCODE I '$D(^LAM(DA,0))#2 D ERR Q
|
|---|
| 36 | . S TAG="|" I +$P(^LAM(DA,0),U,2)'[+LRNLT D ERR Q
|
|---|
| 37 | . K DR D ADD
|
|---|
| 38 | SUF S LRNODE="^LAM(""E"","_+LRNLT_")" F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'[+LRNLT D
|
|---|
| 39 | . K DA,DR,DIC S DA=$QS(LRNODE,3) D ADD
|
|---|
| 40 | Q
|
|---|
| 41 | ADD ;
|
|---|
| 42 | Q:$D(^LAM(DA,4,"B",LRCPT))
|
|---|
| 43 | Q:'$P($G(^LAM(DA,0)),U,2) Q:$P(^(0),U,2)'[+LRNLT
|
|---|
| 44 | S DA(1)=4,DR="18///"_LRCPT_";",DR(1,64)="18///"_LRCPT,DR(2,64.018)=".01///"_LRCPT_";2///"_LRACTDT_";5///"_"CPT"
|
|---|
| 45 | W:$G(LRDBUG) "DA = ",DA_" " D ^DIE I $D(^LAM(DA,4,"B",LRCPT)) W:$G(LRDBUG) ". - " Q
|
|---|
| 46 | S TAG="/" D ERR
|
|---|
| 47 | Q
|
|---|
| 48 | ERR ;
|
|---|
| 49 | S:'$D(TAG) TAG="+" S $P(^LAB(64.81,LRIEN,0),U,9)=$P(^(0),U,9)_LRNLT_TAG
|
|---|
| 50 | W $C(7) W !,"Error Processing WKLD CODE "_LRNLT_" Logged in "_LRIEN,! Q
|
|---|
| 51 | PURG ;
|
|---|
| 52 | K DIK S DIK="^LAB(64.81,",DA=LRIEN,DA(1)=64.81 D ^DIK K DIK
|
|---|
| 53 | Q
|
|---|
