- LR127PO ; IHS/DIR/AAB - LR*5.2*127 POST INSTALL ROUTINE KIDS INSTALL ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**127**;Sep 27, 1994
- EN ;
- STOP ;
- L +^LAM(0):2 I $T S:$D(^LAM(0))#2 $P(^(0),U,3)=99999 L -^LAM(0)
- S $P(^LAB(69.9,1,"NITE"),U,6)=""
- S X=$$ADD^XPDMENU("LR LIM/WKLD MENU","LR7O 60-64")
- W !!," 'National Laboratory File' menu was ",$S(X:"added",1:"NOT ADDED")," to [LR LIM/WKLD] Menu ",! W:'X $C(7)
- I '$O(^LAB(64.81,0)) W $C(7),$$CJ^XLFSTR("No data in file # 64.81 - No linking done.",80) G MSG
- W !!,$$CJ^XLFSTR("Starting CPT to NLT linking Standby",80),!
- CPT ;
- S LRACTDT="JULY 17,1996"
- 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
- . S LRNLT=$P(DATA,U,2),LRCPT=$P(DATA,U,3)
- . Q:'LRNLT!('LRCPT) W "." D LK
- I '$O(^LAB(64.81,0)) W !,$$CJ^XLFSTR("Database Upgrade Completed Sucessfully",80),!! G MSG
- W !?10," Database Upgrade Incomplete - Use FM to Print a Listing"
- W !,"of the LAB NLT/CPT CODES (#64.81) for a listing of errors",!!
- MSG S $P(^LAB(69.9,1,"VSIT"),U)=2
- W !,$$CJ^XLFSTR("PCE/VSIT ON (#615) field in LABORATORY SITE (#69.9) file",80)
- W !,$$CJ^XLFSTR("has been set to BOTH PCE/VSIT AND STOP CODES",80),!!
- W !,$$CJ^XLFSTR("You can use the [Edit or Print WKLD CODES] option for a printed list",80)
- W !,$$CJ^XLFSTR("of linked CPT linked NLT codes.",80),!
- W !!,$$CJ^XLFSTR("Post install completed",80),!!
- W !!?5," The Laboratory LIM should use the National Laboratory File"
- W !,"Menu [LR7O 60-64] to link Laboratory Test to WKLD CODES (#64) "
- W !,"This should be done before 10/1/96 to permit CPT codes to be"
- W !,"passed to the PCE package",!,$C(7),!
- END ;
- Q:$G(LRDBUG)
- K DA,DATA,DIE,DIK,DIC,DR,LRACTDT,LRCODE,LRCPT,LRIEN,LRNLT,LRNODE,TAG,X
- Q
- LK ;
- S LRCODE=0 F S LRCODE=+$O(^LAM("C",LRNLT_" ",LRCODE)) Q:LRCODE<1 D
- . K DA S TAG="*",DA=LRCODE I '$D(^LAM(DA,0))#2 D ERR Q
- . S TAG="|" I +$P(^LAM(DA,0),U,2)'[+LRNLT D ERR Q
- . K DR D ADD
- SUF S LRNODE="^LAM(""E"","_+LRNLT_")" F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'[+LRNLT D
- . K DA,DR,DIC S DA=$QS(LRNODE,3) D ADD
- Q
- ADD ;
- Q:$D(^LAM(DA,4,"B",LRCPT))
- Q:'$P($G(^LAM(DA,0)),U,2) Q:$P(^(0),U,2)'[+LRNLT
- S DA(1)=4,DR="18///"_LRCPT_";",DR(1,64)="18///"_LRCPT,DR(2,64.018)=".01///"_LRCPT_";2///"_LRACTDT_";5///"_"CPT"
- W:$G(LRDBUG) "DA = ",DA_" " D ^DIE I $D(^LAM(DA,4,"B",LRCPT)) W:$G(LRDBUG) ". - " Q
- S TAG="/" D ERR
- Q
- ERR ;
- S:'$D(TAG) TAG="+" S $P(^LAB(64.81,LRIEN,0),U,9)=$P(^(0),U,9)_LRNLT_TAG
- W $C(7) W !,"Error Processing WKLD CODE "_LRNLT_" Logged in "_LRIEN,! Q
- PURG ;
- K DIK S DIK="^LAB(64.81,",DA=LRIEN,DA(1)=64.81 D ^DIK K DIK
- Q
- LR127PO ; IHS/DIR/AAB - LR*5.2*127 POST INSTALL ROUTINE KIDS INSTALL ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**127**;Sep 27, 1994
- EN ;
- STOP ;
- +1 LOCK +^LAM(0):2
- IF $TEST
- IF $DATA(^LAM(0))#2
- SET $PIECE(^(0),U,3)=99999
- LOCK -^LAM(0)
- +2 SET $PIECE(^LAB(69.9,1,"NITE"),U,6)=""
- +3 SET X=$$ADD^XPDMENU("LR LIM/WKLD MENU","LR7O 60-64")
- +4 WRITE !!," 'National Laboratory File' menu was ",$SELECT(X:"added",1:"NOT ADDED")," to [LR LIM/WKLD] Menu ",!
- IF 'X
- WRITE $CHAR(7)
- +5 IF '$ORDER(^LAB(64.81,0))
- WRITE $CHAR(7),$$CJ^XLFSTR("No data in file # 64.81 - No linking done.",80)
- GOTO MSG
- +6 WRITE !!,$$CJ^XLFSTR("Starting CPT to NLT linking Standby",80),!
- CPT ;
- +1 SET LRACTDT="JULY 17,1996"
- +2 KILL DIE
- SET LRIEN=0
- SET DIE="^LAM("
- FOR
- SET LRIEN=$ORDER(^LAB(64.81,LRIEN))
- IF LRIEN<1
- QUIT
- IF $DATA(^(LRIEN,0))#2
- SET DATA=^(0)
- Begin DoDot:1
- +3 SET LRNLT=$PIECE(DATA,U,2)
- SET LRCPT=$PIECE(DATA,U,3)
- +4 IF 'LRNLT!('LRCPT)
- QUIT
- WRITE "."
- DO LK
- End DoDot:1
- IF '$PIECE(^LAB(64.81,LRIEN,0),U,9)
- DO PURG
- +5 IF '$ORDER(^LAB(64.81,0))
- WRITE !,$$CJ^XLFSTR("Database Upgrade Completed Sucessfully",80),!!
- GOTO MSG
- +6 WRITE !?10," Database Upgrade Incomplete - Use FM to Print a Listing"
- +7 WRITE !,"of the LAB NLT/CPT CODES (#64.81) for a listing of errors",!!
- MSG SET $PIECE(^LAB(69.9,1,"VSIT"),U)=2
- +1 WRITE !,$$CJ^XLFSTR("PCE/VSIT ON (#615) field in LABORATORY SITE (#69.9) file",80)
- +2 WRITE !,$$CJ^XLFSTR("has been set to BOTH PCE/VSIT AND STOP CODES",80),!!
- +3 WRITE !,$$CJ^XLFSTR("You can use the [Edit or Print WKLD CODES] option for a printed list",80)
- +4 WRITE !,$$CJ^XLFSTR("of linked CPT linked NLT codes.",80),!
- +5 WRITE !!,$$CJ^XLFSTR("Post install completed",80),!!
- +6 WRITE !!?5," The Laboratory LIM should use the National Laboratory File"
- +7 WRITE !,"Menu [LR7O 60-64] to link Laboratory Test to WKLD CODES (#64) "
- +8 WRITE !,"This should be done before 10/1/96 to permit CPT codes to be"
- +9 WRITE !,"passed to the PCE package",!,$CHAR(7),!
- END ;
- +1 IF $GET(LRDBUG)
- QUIT
- +2 KILL DA,DATA,DIE,DIK,DIC,DR,LRACTDT,LRCODE,LRCPT,LRIEN,LRNLT,LRNODE,TAG,X
- +3 QUIT
- LK ;
- +1 SET LRCODE=0
- FOR
- SET LRCODE=+$ORDER(^LAM("C",LRNLT_" ",LRCODE))
- IF LRCODE<1
- QUIT
- Begin DoDot:1
- +2 KILL DA
- SET TAG="*"
- SET DA=LRCODE
- IF '$DATA(^LAM(DA,0))#2
- DO ERR
- QUIT
- +3 SET TAG="|"
- IF +$PIECE(^LAM(DA,0),U,2)'[+LRNLT
- DO ERR
- QUIT
- +4 KILL DR
- DO ADD
- End DoDot:1
- SUF SET LRNODE="^LAM(""E"","_+LRNLT_")"
- FOR
- SET LRNODE=$QUERY(@LRNODE)
- IF $QSUBSCRIPT(LRNODE,2)'[+LRNLT
- QUIT
- Begin DoDot:1
- +1 KILL DA,DR,DIC
- SET DA=$QSUBSCRIPT(LRNODE,3)
- DO ADD
- End DoDot:1
- +2 QUIT
- ADD ;
- +1 IF $DATA(^LAM(DA,4,"B",LRCPT))
- QUIT
- +2 IF '$PIECE($GET(^LAM(DA,0)),U,2)
- QUIT
- IF $PIECE(^(0),U,2)'[+LRNLT
- QUIT
- +3 SET DA(1)=4
- SET DR="18///"_LRCPT_";"
- SET DR(1,64)="18///"_LRCPT
- SET DR(2,64.018)=".01///"_LRCPT_";2///"_LRACTDT_";5///"_"CPT"
- +4 IF $GET(LRDBUG)
- WRITE "DA = ",DA_" "
- DO ^DIE
- IF $DATA(^LAM(DA,4,"B",LRCPT))
- IF $GET(LRDBUG)
- WRITE ". - "
- QUIT
- +5 SET TAG="/"
- DO ERR
- +6 QUIT
- ERR ;
- +1 IF '$DATA(TAG)
- SET TAG="+"
- SET $PIECE(^LAB(64.81,LRIEN,0),U,9)=$PIECE(^(0),U,9)_LRNLT_TAG
- +2 WRITE $CHAR(7)
- WRITE !,"Error Processing WKLD CODE "_LRNLT_" Logged in "_LRIEN,!
- QUIT
- PURG ;
- +1 KILL DIK
- SET DIK="^LAB(64.81,"
- SET DA=LRIEN
- SET DA(1)=64.81
- DO ^DIK
- KILL DIK
- +2 QUIT
