- LAMIAUT1 ; IHS/DIR/FJE - CONTINUE MICRO AUTO INSTRUMENT PROGRAM VITEK ; 22-Oct-2013 09:22 ; MKK
- ;;5.2;LA;**1002,1033**;NOV 01, 1997
- ;
- EN ; From LAMIAUT0
- Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W @IOF S Y(0)=^(0),LRDFN=+Y(0),LRDPF=$P(Y(0),U,2),LRLLOC=$P(Y(0),U,7),LRPHY=$P(Y(0),U,8),LRACCN=^(.2)
- S LRODT=$P(Y(0),U,4),LRSN=$P(Y(0),U,5),(LRSPEC,LRSAMP)=0
- S Y(3)=^(3),LRCDT=$P(Y(3),U),LRDTR=$P(Y(3),U,3),LRIDT=$P(Y(3),U,5),LREAL=$P(Y(3),U,2),LRI=$O(^(5,0)) I $D(^(LRI,0)) S LRSPEC=+^(0),LRSAMP=+$P(^(0),U,2)
- S DFN=$P(^LR(LRDFN,0),U,3),LRPHYN=$S($D(^VA(200,+LRPHY,0)):$P(^(0),U),1:"Unknown")
- PAT ;
- ;D PT^LRX W !,"ACC # (",LRAN,") " W $$DTF^LRAFUNC1(LRCDT),!!?10,PNM," SSN: ",SSN," LOC: ",LRLLOC
- D PT^LRX W !,"ACC # (",LRAN,") " W $$DTF^LRAFUNC1(LRCDT),!!?10,PNM," HRCN: ",HRCN," LOC: ",LRLLOC ;IHS/ANMC/CLS 11/1/95
- W !?5,"Specimen: ",$S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:"Unknown")," Sample: ",$S($D(^LAB(62,+LRSAMP,0)):$P(^(0),U),1:"Unknown"),!
- I $D(^LRO(69,LRODT,1,LRSN,6,+$O(^LRO(69,LRODT,1,LRSN,6,0)),0)) W !," Comment on Specimem " S I=0 F A=0:0 S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I="" W ?30,^(I,0),!
- I $D(^LR(LRDFN,"MI",LRIDT,2,+$O(^LR(LRDFN,"MI",LRIDT,2,0)),0)) W !,"GRAM STAIN " S I=0 F A=0:0 S I=$O(^LR(LRDFN,"MI",LRIDT,2,I)) Q:I="" W ?15,^(I,0),!
- I $D(^LR(LRDFN,"MI",LRIDT,99)) W !,"Comment on Specimen : ",^(99)
- RD S %=1,LREND=0 W !!?10,"Is this the correct patient/specimen " D YN^DICN I %'=1 Q
- D EXP^LAMIAUT4 Q:LREND S LRCAPOK=1 G:'$D(^LR(LRDFN,"MI",0))!('$D(^LR(LRDFN,"MI",LRIDT,0))) BB
- RD1 ;
- G:'$P(^LR(LRDFN,"MI",LRIDT,0),U,3) RD2 W !,"Final report has been verified by microbiology supervisor.",$C(7),!,"If you proceed in editing, this report will need to be reverified."
- F I=0:0 W !,?20,"OK" S %=1 D YN^DICN Q:% W !,"Enter 'Y' or 'N':"
- I %=2!(%<0) S LRCAPOK=0 Q
- RD2 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3)!$P(^LR(LRDFN,"MI",LRIDT,0),U,9) S LRUNDO=1
- BB I '$D(^LR(LRDFN,"MI",0)) S ^LR(LRDFN,"MI",0)="^63.05DA^"_LRIDT_U_0
- S ^LR(LRDFN,"MI",0)=$P(^LR(LRDFN,"MI",0),U,1,2)_U_LRIDT_U_(1+$P(^(0),U,4))
- S:'$D(^LR(LRDFN,"MI",LRIDT,3,0)) ^(0)="^63.3PA^^"
- I '$D(^LR(LRDFN,"MI",LRIDT,0)) S ^(0)=LRCDT_U_LREAL_"^^^"_LRSPEC_U_LRACCN_U_LRPHY_U_LRLLOC_"^^"_LRDTR_U_LRSAMP
- ;
- L +(^LR(LRDFN,"MI",LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN)):0 I '$T W !!?7,$C(7),"Another User is Editing this Patient",!! Q
- K LRBDUP F I=0:0 S I=$O(^LR(LRDFN,"MI",LRIDT,3,I)) Q:I<1 I $D(^(I,0)) S BB=+^(0) I BB S:'$D(LRBDUP(BB))#2 LRBDUP(BB)=0 S LRBDUP(BB)=LRBDUP(BB)+1,LRBDUP(BB,I)="" K BB
- ; S LRIFN=+$O(^LAH(LRLL,1,"C",LRAN,0)) G:'LRIFN CLEAR I '$D(^LAH(LRLL,1,LRIFN,3)) W !,$C(7),?10,"No Organism for this Accession" G CLEAR
- ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
- S:+$G(LRIFN)<1 LRIFN=+$O(^LAH(LRLL,1,"C",LRAN,0)) G:'LRIFN CLEAR
- I '$D(^LAH(LRLL,1,LRIFN,3))&($D(^TMP("BLRMIAUT",$J,"HL7"))<1) W !,$C(7),?10,"No Organism for this Accession" G CLEAR
- ; ----- END IHS/MSC/MKK - LR*5.2*1033
- ; S ^XTMP("LAMIAUT1",$J,$H,"LRIFN")=LRIFN S LRIFN=$O(^LAH(LRLL,1,"U",+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),0)) G:'LRIFN CLEAR I '$D(^LAH(LRLL,1,LRIFN,3)) W !,$C(7),?10,"No Organism for this Accession" G CLEAR ; IHS/MSC/MKK - LR*5.2*1033
- F II=0:0 S II=+$O(^LAH(LRLL,1,LRIFN,3,II)) Q:II<1 D ORG^LAMIAUT2 Q:LREND
- DR ;
- D ^LAMIAUT2 Q:LREND I '+$O(^LR(LRDFN,"MI",LRIDT,3,0)) W !?10,"NO ORGANISM TO DISPLAY " Q
- K DR,DIC,DIE,DA S DA(1)=LRDFN,DA=LRIDT,Y(0)=^LR(LRDFN,"MI",LRIDT,0),DIE="^LR("_LRDFN_",""MI"","
- ;S DR="11.55////^S X=DUZ;.99;11.5;11.6;13" D ^DIE
- ;
- ; ----- BEGIN IHS/CMI/MAW - LR*5.2*1033 -- 03/11/2013
- ; MU2 -- The line above asks report status (field 11.5), need to change this to get from ^LAH if there
- N RS
- S RS=$P($G(^LAH(LRLL,1,LRIFN,"IHS")),U)
- S DR=$S($G(RS)]"":"11.55////^S X=DUZ;.99;11.5///"_RS_";11.6;13",1:"11.55////^S X=DUZ;.99;11.5;11.6;13") D ^DIE
- ; ----- END IHS/CMI/MAW - LR*5.2*1033 -- 03/11/2013
- ;
- S LREND=0 D ^LAMIAUT3 Q:LREND D ^LAMIAUT4
- L -(^LR(LRDFN,"MI",LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN))
- Q
- CLEAR ;
- S (LRUNDO,LACAPOK)=0 LOCK Q
- LAMIAUT1 ; IHS/DIR/FJE - CONTINUE MICRO AUTO INSTRUMENT PROGRAM VITEK ; 22-Oct-2013 09:22 ; MKK
- +1 ;;5.2;LA;**1002,1033**;NOV 01, 1997
- +2 ;
- EN ; From LAMIAUT0
- +1 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- QUIT
- WRITE @IOF
- SET Y(0)=^(0)
- SET LRDFN=+Y(0)
- SET LRDPF=$PIECE(Y(0),U,2)
- SET LRLLOC=$PIECE(Y(0),U,7)
- SET LRPHY=$PIECE(Y(0),U,8)
- SET LRACCN=^(.2)
- +2 SET LRODT=$PIECE(Y(0),U,4)
- SET LRSN=$PIECE(Y(0),U,5)
- SET (LRSPEC,LRSAMP)=0
- +3 SET Y(3)=^(3)
- SET LRCDT=$PIECE(Y(3),U)
- SET LRDTR=$PIECE(Y(3),U,3)
- SET LRIDT=$PIECE(Y(3),U,5)
- SET LREAL=$PIECE(Y(3),U,2)
- SET LRI=$ORDER(^(5,0))
- IF $DATA(^(LRI,0))
- SET LRSPEC=+^(0)
- SET LRSAMP=+$PIECE(^(0),U,2)
- +4 SET DFN=$PIECE(^LR(LRDFN,0),U,3)
- SET LRPHYN=$SELECT($DATA(^VA(200,+LRPHY,0)):$PIECE(^(0),U),1:"Unknown")
- PAT ;
- +1 ;D PT^LRX W !,"ACC # (",LRAN,") " W $$DTF^LRAFUNC1(LRCDT),!!?10,PNM," SSN: ",SSN," LOC: ",LRLLOC
- +2 ;IHS/ANMC/CLS 11/1/95
- DO PT^LRX
- WRITE !,"ACC # (",LRAN,") "
- WRITE $$DTF^LRAFUNC1(LRCDT),!!?10,PNM," HRCN: ",HRCN," LOC: ",LRLLOC
- +3 WRITE !?5,"Specimen: ",$SELECT($DATA(^LAB(61,+LRSPEC,0)):$PIECE(^(0),U),1:"Unknown")," Sample: ",$SELECT($DATA(^LAB(62,+LRSAMP,0)):$PIECE(^(0),U),1:"Unknown"),!
- +4 IF $DATA(^LRO(69,LRODT,1,LRSN,6,+$ORDER(^LRO(69,LRODT,1,LRSN,6,0)),0))
- WRITE !," Comment on Specimem "
- SET I=0
- FOR A=0:0
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,6,I))
- IF I=""
- QUIT
- WRITE ?30,^(I,0),!
- +5 IF $DATA(^LR(LRDFN,"MI",LRIDT,2,+$ORDER(^LR(LRDFN,"MI",LRIDT,2,0)),0))
- WRITE !,"GRAM STAIN "
- SET I=0
- FOR A=0:0
- SET I=$ORDER(^LR(LRDFN,"MI",LRIDT,2,I))
- IF I=""
- QUIT
- WRITE ?15,^(I,0),!
- +6 IF $DATA(^LR(LRDFN,"MI",LRIDT,99))
- WRITE !,"Comment on Specimen : ",^(99)
- RD SET %=1
- SET LREND=0
- WRITE !!?10,"Is this the correct patient/specimen "
- DO YN^DICN
- IF %'=1
- QUIT
- +1 DO EXP^LAMIAUT4
- IF LREND
- QUIT
- SET LRCAPOK=1
- IF '$DATA(^LR(LRDFN,"MI",0))!('$DATA(^LR(LRDFN,"MI",LRIDT,0)))
- GOTO BB
- RD1 ;
- +1 IF '$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)
- GOTO RD2
- WRITE !,"Final report has been verified by microbiology supervisor.",$CHAR(7),!,"If you proceed in editing, this report will need to be reverified."
- +2 FOR I=0:0
- WRITE !,?20,"OK"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- WRITE !,"Enter 'Y' or 'N':"
- +3 IF %=2!(%<0)
- SET LRCAPOK=0
- QUIT
- RD2 IF $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)!$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,9)
- SET LRUNDO=1
- BB IF '$DATA(^LR(LRDFN,"MI",0))
- SET ^LR(LRDFN,"MI",0)="^63.05DA^"_LRIDT_U_0
- +1 SET ^LR(LRDFN,"MI",0)=$PIECE(^LR(LRDFN,"MI",0),U,1,2)_U_LRIDT_U_(1+$PIECE(^(0),U,4))
- +2 IF '$DATA(^LR(LRDFN,"MI",LRIDT,3,0))
- SET ^(0)="^63.3PA^^"
- +3 IF '$DATA(^LR(LRDFN,"MI",LRIDT,0))
- SET ^(0)=LRCDT_U_LREAL_"^^^"_LRSPEC_U_LRACCN_U_LRPHY_U_LRLLOC_"^^"_LRDTR_U_LRSAMP
- +4 ;
- +5 LOCK +(^LR(LRDFN,"MI",LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN)):0
- IF '$TEST
- WRITE !!?7,$CHAR(7),"Another User is Editing this Patient",!!
- QUIT
- +6 KILL LRBDUP
- FOR I=0:0
- SET I=$ORDER(^LR(LRDFN,"MI",LRIDT,3,I))
- IF I<1
- QUIT
- IF $DATA(^(I,0))
- SET BB=+^(0)
- IF BB
- IF '$DATA(LRBDUP(BB))#2
- SET LRBDUP(BB)=0
- SET LRBDUP(BB)=LRBDUP(BB)+1
- SET LRBDUP(BB,I)=""
- KILL BB
- +7 ; S LRIFN=+$O(^LAH(LRLL,1,"C",LRAN,0)) G:'LRIFN CLEAR I '$D(^LAH(LRLL,1,LRIFN,3)) W !,$C(7),?10,"No Organism for this Accession" G CLEAR
- +8 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
- +9 IF +$GET(LRIFN)<1
- SET LRIFN=+$ORDER(^LAH(LRLL,1,"C",LRAN,0))
- IF 'LRIFN
- GOTO CLEAR
- +10 IF '$DATA(^LAH(LRLL,1,LRIFN,3))&($DATA(^TMP("BLRMIAUT",$JOB,"HL7"))<1)
- WRITE !,$CHAR(7),?10,"No Organism for this Accession"
- GOTO CLEAR
- +11 ; ----- END IHS/MSC/MKK - LR*5.2*1033
- +12 ; S ^XTMP("LAMIAUT1",$J,$H,"LRIFN")=LRIFN S LRIFN=$O(^LAH(LRLL,1,"U",+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),0)) G:'LRIFN CLEAR I '$D(^LAH(LRLL,1,LRIFN,3)) W !,$C(7),?10,"No Organism for this Accession" G CLEAR ; IHS/MSC/MKK - LR*5.2*1033
- +13 FOR II=0:0
- SET II=+$ORDER(^LAH(LRLL,1,LRIFN,3,II))
- IF II<1
- QUIT
- DO ORG^LAMIAUT2
- IF LREND
- QUIT
- DR ;
- +1 DO ^LAMIAUT2
- IF LREND
- QUIT
- IF '+$ORDER(^LR(LRDFN,"MI",LRIDT,3,0))
- WRITE !?10,"NO ORGANISM TO DISPLAY "
- QUIT
- +2 KILL DR,DIC,DIE,DA
- SET DA(1)=LRDFN
- SET DA=LRIDT
- SET Y(0)=^LR(LRDFN,"MI",LRIDT,0)
- SET DIE="^LR("_LRDFN_",""MI"","
- +3 ;S DR="11.55////^S X=DUZ;.99;11.5;11.6;13" D ^DIE
- +4 ;
- +5 ; ----- BEGIN IHS/CMI/MAW - LR*5.2*1033 -- 03/11/2013
- +6 ; MU2 -- The line above asks report status (field 11.5), need to change this to get from ^LAH if there
- +7 NEW RS
- +8 SET RS=$PIECE($GET(^LAH(LRLL,1,LRIFN,"IHS")),U)
- +9 SET DR=$SELECT($GET(RS)]"":"11.55////^S X=DUZ;.99;11.5///"_RS_";11.6;13",1:"11.55////^S X=DUZ;.99;11.5;11.6;13")
- DO ^DIE
- +10 ; ----- END IHS/CMI/MAW - LR*5.2*1033 -- 03/11/2013
- +11 ;
- +12 SET LREND=0
- DO ^LAMIAUT3
- IF LREND
- QUIT
- DO ^LAMIAUT4
- +13 LOCK -(^LR(LRDFN,"MI",LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN))
- +14 QUIT
- CLEAR ;
- +1 SET (LRUNDO,LACAPOK)=0
- LOCK
- QUIT
