LREPIPI ;DALOI/CKA - Local Pathogens Input ;19 Jul 2013 4:06 PM
;;5.2;LAB SERVICE;**281,421**;Sep 27, 1994;Build 48
; Reference to $$SITE^VASITE supported by IA #10112
; Reference to ^ORD(101 supported by IA #872
; Reference to $$CSI^ICDEX supported by IA #5747
;
EN ;
;
S LRNO="",SITE=$P($$SITE^VASITE,U)
LKUP ;
I $G(XQY0)["PARAMETER SETUP" D PARLKUP G:$D(DTOUT)!($D(DUOUT))!($G(Y)=-1) EXIT G EN
S DIR(0)="FO^3:30",DIR("A")="LOCAL PATHOGEN NAME",DIR("?")="Enter the name of the local pathogen [3-30 characters]. You may also enter part of the name for look up purposes."
S DIR("??")="^S D=""B"",DIC=""^LAB(69.5,"",DIC(0)=""AEMZ"",DIC(""S"")=""I (Y>99)"" D DQ^DICQ K DIC"
D ^DIR K DIR I $D(DIRUT) G EXIT
S LRX=Y
S DIC="^LAB(69.5,",DIC("S")="I Y>99",DIC(0)="EMZ" D ^DIC K DIC S LREPIFN=+Y
I $G(LRDEL) Q
I Y="" D EXIT G EN
I $D(DTOUT) G NOU
I Y'<0 D FND
I Y<0 D ADD D EXIT G EN
G:$G(Y)["^"!($D(DTOUT)) NOU
G:LRNO EN D:LRY EDIT G EN
G EN
Q
;
ADD ;
I $G(LROPTION)="LREPI PARAMETER SETUP" D I $D(DIRUT) D EXIT Q
.S DIR(0)="E",DIR("A")="Press the return key to continue or '^' to exit"
.S DIR("A",1)="Local Pathogen(s) cannot be added with this option." D ^DIR
.Q
S DIR(0)="Y",DIR("A")="Do you want to add this local pathogen",DIR("B")="YES" D ^DIR G:$D(DTOUT) NOU K DIR
I 'Y Q
S LRNUM=99
F S LRNUM1=$O(^LAB(69.5,LRNUM)) Q:'LRNUM1 S LRNUM=LRNUM+1
S LRDA=LRNUM+1
K DD,DO
S DIC="^LAB(69.5,"
S DIC(0)="L"
S DLAYGO=69.5
S DINUM=LRDA
S X=LRX_SITE
D FILE^DICN
I Y=-1 D NOU G EN
S $P(^LAB(69.5,LRDA,0),U,2)=0
S $P(^LAB(69.5,LRDA,0),U,9)=LRDA
S LRPROT=0,LRPROT=$O(^ORD(101,"B","LREPI",LRPROT))
S $P(^LAB(69.5,LRDA,0),U,7)=LRPROT
S LREPIFN=LRDA
EDIT S DA=LREPIFN
I $D(^LAB(69.5,DA,3,"B")) D
.S LRINT=0
.F S LRINT=$O(^LAB(69.5,DA,3,"B",LRINT)) Q:+LRINT=0 D
..S LRTMP=$$ICDDATA^ICDXCODE($$CSI^ICDEX(80,LRINT),LRINT,,)
..Q:LRTMP'>0
..S DIE="^LAB(69.5,"_DA_",3,",DR="1////"_$P(LRTMP,U,20) D ^DIE
K DIE,LRINT,LRTMP
S LRDAICD=0 F S LRDAICD=$O(^LAB(69.5,DA,3,LRDAICD)) Q:'LRDAICD D
. I $P(^LAB(69.5,DA,3,LRDAICD,0),U,1)="" D
.. K ^LAB(69.5,DA,3,LRDAICD,0)
S DLAYGO=69.5,DDSFILE="^LAB(69.5,"
S DR="[LREPI9]"
D ^DDS
K DDSFILE(1)
W !!
S LRDAICD=0 F S LRDAICD=$O(^LAB(69.5,DA,3,LRDAICD)) Q:'LRDAICD D
. N LRCODSET S LRCODSET=$$CSI^ICDEX(80,$P(^LAB(69.5,DA,3,LRDAICD,0),U))
. S $P(^LAB(69.5,DA,3,LRDAICD,0),U,2)=LRCODSET
D EXIT
Q
EXIT K ^TMP("ICDEXLK",$J),DA,DD,DDSFILE,DLAYGO,DIC,DIK,DINUM,DIR,DIRUT,DO,DR,DTOUT,DUOUT,L,LRDA,LRDEL,LRDAICD,LRNO,LRNUM,LRNUM1,LREPIFN,LRPROT,LRX,LRXX,LRY,SITE,X,Y Q
FND W !,"This pathogen is already entered as a local pathogen.",!
S DIC="^LAB(69.5,",DA=+Y,DR="0:6;8:9" D EN^DIQ
S DIR(0)="Y",DIR("A")="Is this the correct one" D ^DIR K DIR
I 'Y S LRNO=1 W !! Q
YN1 S DIR(0)="Y",DIR("A")="Do you want to edit this local pathogen",DIR("B")="NO"
D ^DIR
K DIR
S LRY=Y
W !! Q
Q
NOU W !!,$C(7),?20,"NO UPDATING HAS OCCURRED!!!" K DIR G:$D(DTOUT) EXIT W !! G EN
DELETE ;DELETE LOCAL PATHOGEN
S LRDEL=1
D EN
I '$D(Y) G EXIT
S LRXX=Y
G:$D(DTOUT)!($D(DUOUT))!(Y="") EXIT
S DIC="^LAB(69.5,"
S DIC(0)="EMZ"
S DIC("S")="I $P(^(0),U,9)>99"
D ^DIC
K DIC
I Y=-1 W !,"NO MATCH FOUND." G DELETE
S LRY=Y
S DIR(0)="Y",DIR("A")="Do you really want to delete this pathogen"
D ^DIR
K DIR
G:$D(DTOUT)!($D(DUOUT)) EXIT
I 'Y G DELETE
I LRY>99 S DA=+LRY D KILL G DELETE
G DELETE
;
KILL S DIK="^LAB(69.5,"
D ^DIK
W !!,"Entry ",$P(LRY,U,2)," deleted."
K DIK
Q
INQUIRY S DIC="^LAB(69.5,",DIC("A")="Select Pathogen: ",DIC(0)="AEMQ" D ^DIC K DIC
I Y<0 K DIC,DA,D0,DR,Y Q
INQ1 S DIC="^LAB(69.5,",DA=+Y,DR="0:6" D EN^DIQ
D PAUSE^LREPIRS2
I $G(LRQUIT) K DIC,DA,D0,DR,LRQUIT,Y Q
S DR="8:9" D EN^DIQ
K DIC,DA,DO,DR,LRQUIT,Y
G INQUIRY
PRINT S L=0,DIC="^LAB(69.5,"
D EN1^DIP
Q
;
DFLT() N LRDATE D NOW^%DTC S LRDATE=X
Q $S(LRDATE'<$$IMPDATE^LEXU("10D"):30,1:1)
PARLKUP ;
S DIC("S")="I (Y<100)",DIC="^LAB(69.5,",DIC(0)="AEMQ" D ^DIC K DIC S LREPIFN=+Y
Q:$D(DTOUT)!($D(DUOUT))!(Y=-1)
D EDIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIPI 4104 printed Oct 16, 2024@18:15:06 Page 2
LREPIPI ;DALOI/CKA - Local Pathogens Input ;19 Jul 2013 4:06 PM
+1 ;;5.2;LAB SERVICE;**281,421**;Sep 27, 1994;Build 48
+2 ; Reference to $$SITE^VASITE supported by IA #10112
+3 ; Reference to ^ORD(101 supported by IA #872
+4 ; Reference to $$CSI^ICDEX supported by IA #5747
+5 ;
EN ;
+1 ;
+2 SET LRNO=""
SET SITE=$PIECE($$SITE^VASITE,U)
LKUP ;
+1 IF $GET(XQY0)["PARAMETER SETUP"
DO PARLKUP
if $DATA(DTOUT)!($DATA(DUOUT))!($GET(Y)=-1)
GOTO EXIT
GOTO EN
+2 SET DIR(0)="FO^3:30"
SET DIR("A")="LOCAL PATHOGEN NAME"
SET DIR("?")="Enter the name of the local pathogen [3-30 characters]. You may also enter part of the name for look up purposes."
+3 SET DIR("??")="^S D=""B"",DIC=""^LAB(69.5,"",DIC(0)=""AEMZ"",DIC(""S"")=""I (Y>99)"" D DQ^DICQ K DIC"
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO EXIT
+5 SET LRX=Y
+6 SET DIC="^LAB(69.5,"
SET DIC("S")="I Y>99"
SET DIC(0)="EMZ"
DO ^DIC
KILL DIC
SET LREPIFN=+Y
+7 IF $GET(LRDEL)
QUIT
+8 IF Y=""
DO EXIT
GOTO EN
+9 IF $DATA(DTOUT)
GOTO NOU
+10 IF Y'<0
DO FND
+11 IF Y<0
DO ADD
DO EXIT
GOTO EN
+12 if $GET(Y)["^"!($DATA(DTOUT))
GOTO NOU
+13 if LRNO
GOTO EN
if LRY
DO EDIT
GOTO EN
+14 GOTO EN
+15 QUIT
+16 ;
ADD ;
+1 IF $GET(LROPTION)="LREPI PARAMETER SETUP"
Begin DoDot:1
+2 SET DIR(0)="E"
SET DIR("A")="Press the return key to continue or '^' to exit"
+3 SET DIR("A",1)="Local Pathogen(s) cannot be added with this option."
DO ^DIR
+4 QUIT
End DoDot:1
IF $DATA(DIRUT)
DO EXIT
QUIT
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want to add this local pathogen"
SET DIR("B")="YES"
DO ^DIR
if $DATA(DTOUT)
GOTO NOU
KILL DIR
+6 IF 'Y
QUIT
+7 SET LRNUM=99
+8 FOR
SET LRNUM1=$ORDER(^LAB(69.5,LRNUM))
if 'LRNUM1
QUIT
SET LRNUM=LRNUM+1
+9 SET LRDA=LRNUM+1
+10 KILL DD,DO
+11 SET DIC="^LAB(69.5,"
+12 SET DIC(0)="L"
+13 SET DLAYGO=69.5
+14 SET DINUM=LRDA
+15 SET X=LRX_SITE
+16 DO FILE^DICN
+17 IF Y=-1
DO NOU
GOTO EN
+18 SET $PIECE(^LAB(69.5,LRDA,0),U,2)=0
+19 SET $PIECE(^LAB(69.5,LRDA,0),U,9)=LRDA
+20 SET LRPROT=0
SET LRPROT=$ORDER(^ORD(101,"B","LREPI",LRPROT))
+21 SET $PIECE(^LAB(69.5,LRDA,0),U,7)=LRPROT
+22 SET LREPIFN=LRDA
EDIT SET DA=LREPIFN
+1 IF $DATA(^LAB(69.5,DA,3,"B"))
Begin DoDot:1
+2 SET LRINT=0
+3 FOR
SET LRINT=$ORDER(^LAB(69.5,DA,3,"B",LRINT))
if +LRINT=0
QUIT
Begin DoDot:2
+4 SET LRTMP=$$ICDDATA^ICDXCODE($$CSI^ICDEX(80,LRINT),LRINT,,)
+5 if LRTMP'>0
QUIT
+6 SET DIE="^LAB(69.5,"_DA_",3,"
SET DR="1////"_$PIECE(LRTMP,U,20)
DO ^DIE
End DoDot:2
End DoDot:1
+7 KILL DIE,LRINT,LRTMP
+8 SET LRDAICD=0
FOR
SET LRDAICD=$ORDER(^LAB(69.5,DA,3,LRDAICD))
if 'LRDAICD
QUIT
Begin DoDot:1
+9 IF $PIECE(^LAB(69.5,DA,3,LRDAICD,0),U,1)=""
Begin DoDot:2
+10 KILL ^LAB(69.5,DA,3,LRDAICD,0)
End DoDot:2
End DoDot:1
+11 SET DLAYGO=69.5
SET DDSFILE="^LAB(69.5,"
+12 SET DR="[LREPI9]"
+13 DO ^DDS
+14 KILL DDSFILE(1)
+15 WRITE !!
+16 SET LRDAICD=0
FOR
SET LRDAICD=$ORDER(^LAB(69.5,DA,3,LRDAICD))
if 'LRDAICD
QUIT
Begin DoDot:1
+17 NEW LRCODSET
SET LRCODSET=$$CSI^ICDEX(80,$PIECE(^LAB(69.5,DA,3,LRDAICD,0),U))
+18 SET $PIECE(^LAB(69.5,DA,3,LRDAICD,0),U,2)=LRCODSET
End DoDot:1
+19 DO EXIT
+20 QUIT
EXIT KILL ^TMP("ICDEXLK",$JOB),DA,DD,DDSFILE,DLAYGO,DIC,DIK,DINUM,DIR,DIRUT,DO,DR,DTOUT,DUOUT,L,LRDA,LRDEL,LRDAICD,LRNO,LRNUM,LRNUM1,LREPIFN,LRPROT,LRX,LRXX,LRY,SITE,X,Y
QUIT
FND WRITE !,"This pathogen is already entered as a local pathogen.",!
+1 SET DIC="^LAB(69.5,"
SET DA=+Y
SET DR="0:6;8:9"
DO EN^DIQ
+2 SET DIR(0)="Y"
SET DIR("A")="Is this the correct one"
DO ^DIR
KILL DIR
+3 IF 'Y
SET LRNO=1
WRITE !!
QUIT
YN1 SET DIR(0)="Y"
SET DIR("A")="Do you want to edit this local pathogen"
SET DIR("B")="NO"
+1 DO ^DIR
+2 KILL DIR
+3 SET LRY=Y
+4 WRITE !!
QUIT
+5 QUIT
NOU WRITE !!,$CHAR(7),?20,"NO UPDATING HAS OCCURRED!!!"
KILL DIR
if $DATA(DTOUT)
GOTO EXIT
WRITE !!
GOTO EN
DELETE ;DELETE LOCAL PATHOGEN
+1 SET LRDEL=1
+2 DO EN
+3 IF '$DATA(Y)
GOTO EXIT
+4 SET LRXX=Y
+5 if $DATA(DTOUT)!($DATA(DUOUT))!(Y="")
GOTO EXIT
+6 SET DIC="^LAB(69.5,"
+7 SET DIC(0)="EMZ"
+8 SET DIC("S")="I $P(^(0),U,9)>99"
+9 DO ^DIC
+10 KILL DIC
+11 IF Y=-1
WRITE !,"NO MATCH FOUND."
GOTO DELETE
+12 SET LRY=Y
+13 SET DIR(0)="Y"
SET DIR("A")="Do you really want to delete this pathogen"
+14 DO ^DIR
+15 KILL DIR
+16 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+17 IF 'Y
GOTO DELETE
+18 IF LRY>99
SET DA=+LRY
DO KILL
GOTO DELETE
+19 GOTO DELETE
+20 ;
KILL SET DIK="^LAB(69.5,"
+1 DO ^DIK
+2 WRITE !!,"Entry ",$PIECE(LRY,U,2)," deleted."
+3 KILL DIK
+4 QUIT
INQUIRY SET DIC="^LAB(69.5,"
SET DIC("A")="Select Pathogen: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+1 IF Y<0
KILL DIC,DA,D0,DR,Y
QUIT
INQ1 SET DIC="^LAB(69.5,"
SET DA=+Y
SET DR="0:6"
DO EN^DIQ
+1 DO PAUSE^LREPIRS2
+2 IF $GET(LRQUIT)
KILL DIC,DA,D0,DR,LRQUIT,Y
QUIT
+3 SET DR="8:9"
DO EN^DIQ
+4 KILL DIC,DA,DO,DR,LRQUIT,Y
+5 GOTO INQUIRY
PRINT SET L=0
SET DIC="^LAB(69.5,"
+1 DO EN1^DIP
+2 QUIT
+3 ;
DFLT() NEW LRDATE
DO NOW^%DTC
SET LRDATE=X
+1 QUIT $SELECT(LRDATE'<$$IMPDATE^LEXU("10D"):30,1:1)
PARLKUP ;
+1 SET DIC("S")="I (Y<100)"
SET DIC="^LAB(69.5,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
SET LREPIFN=+Y
+2 if $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
QUIT
+3 DO EDIT
+4 QUIT
