- ORDV05X ; slc/jdl - Microbiology Extended Extracts ;6/13/2001 11:59AM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,208**;Dec 17, 1997
- ;;Called from ORDV05E, return ^TMP("ORM",$J in GCPR format
- ;;For Parasitology,Mycology,Mycobacteriology,Virology in GCPR
- PARA ; Get Parasitology Work-up
- N DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM,PARAIEN
- I $D(^LR(LRDFN,"MI",IX,5)) D
- . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=15,DIQ="STATUS"
- . S DIQ(0)="E" D EN^DIQ1
- . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,15,"E")," ",1),1,6)
- S PN=0
- F S PN=$O(^LR(LRDFN,"MI",IX,6,PN)) Q:+PN'>0 D
- . S PARAIEN=+^LR(LRDFN,"MI",IX,6,PN,0),SN=0
- . D IDPARA
- . F S SN=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN)) Q:+SN'>0 D IDPARA
- ; Parasitology smear/prep
- S SMEAR=0
- F S SMEAR=$O(^LR(LRDFN,"MI",IX,24,SMEAR)) Q:SMEAR'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","PARA","SMEAR",SMEAR)=^(SMEAR,0)
- ; remark
- S RMK=0
- F S RMK=$O(^LR(LRDFN,"MI",IX,7,RMK)) Q:+RMK'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","PARA","RMK",RMK)=^(RMK,0)
- Q
- IDPARA ;Get parasite stage, quantity, and comment
- N DA,DIC,DIQ,DR,PARA,STAGE
- I 'SN S PARA=$S($D(EXPAND):PN_";"_$P(^LAB(61.2,PARAIEN,0),U),1:$P(^LAB(61.2,PARAIEN,0),U)),^TMP("ORM",$J,RPT,SS,"RPT",PARAIEN)="P"_U_PARA Q
- S DA=LRDFN,DA(63.05)=IX,DA(63.34)=PN,DA(63.35)=SN,DIC=63,DIQ="STAGE",DIQ(0)="E",DR=5,DR(63.05)=16,DR(63.34)=1,DR(63.35)=".01;1" D EN^DIQ1
- S ^TMP("ORM",$J,RPT,SS,"RPT",PARAIEN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
- ;comment
- S COM=0
- F S COM=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN,1,COM)) Q:COM'>0 S ^TMP("ORM",$J,RPT,SS,"RPT",PARAIEN,SN,COM)=^(COM,0)
- Q
- MYCO ; Get Mycology Work-up
- N DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR,MYCOIEN
- I $D(^LR(LRDFN,"MI",IX,8)) D
- . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=19,DIQ="STATUS"
- . S DIQ(0)="E" D EN^DIQ1
- . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,19,"E")," ",1),1,6)
- S ISO=0
- F S ISO=$O(^LR(LRDFN,"MI",IX,9,ISO)) Q:+ISO'>0 D
- . S MYCOIEN=+^LR(LRDFN,"MI",IX,9,ISO,0)
- . D FNGS S ^TMP("ORM",$J,RPT,SS,"RPT",MYCOIEN)="M"_U_$S($D(EXPAND):ISO_";"_FUN,1:FUN)
- . ;comment
- . S COM=0
- . F S COM=$O(^LR(LRDFN,"MI",IX,9,ISO,1,COM)) Q:COM'>0 S ^TMP("ORM",$J,RPT,SS,"RPT",MYCOIEN,"COM",COM)=^(COM,0)
- ; Mycology smear/prep
- S SMEAR=0
- F S SMEAR=$O(^LR(LRDFN,"MI",IX,15,SMEAR)) Q:SMEAR'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","MYCO","SMEAR",SMEAR)=^(SMEAR,0)
- ; remark
- S RMK=0
- F S RMK=$O(^LR(LRDFN,"MI",IX,10,RMK)) Q:+RMK'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","MYCO","RMK",RMK)=^(RMK,0)
- Q
- FNGS N QTY
- S FUN=+^LR(LRDFN,"MI",IX,9,ISO,0),QTY=$P(^(0),U,2),FUN=$P(^LAB(61.2,FUN,0),U)
- S FUN=FUN_U_QTY
- Q
- TB ; Gets Mycobacteriology Work-up
- N DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,Y,COM,MY,GMTB,GMTBA,TBIEN
- I $D(^LR(LRDFN,"MI",IX,11)) D
- . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)="23;24;25",DIQ="STATUS"
- . S DIQ(0)="E" D EN^DIQ1
- . ;Status, Acid Fast Stain, Quantity
- . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,23,"E")," ",1),1,6)
- . S ^TMP("ORM",$J,RPT,SS,"IMP","TB","ACID FAST STAIN")=STATUS(63.05,IX,24,"E")_U_STATUS(63.05,IX,25,"E")
- S ISO=0
- F S ISO=$O(^LR(LRDFN,"MI",IX,12,ISO)) Q:+ISO'>0 D
- . S TBIEN=+^LR(LRDFN,"MI",IX,12,ISO,0)
- . D MYCB S ^TMP("ORM",$J,RPT,SS,"RPT",TBIEN)="TB"_U_$S($D(EXPAND):ISO_";"_MB,1:MB)
- . ;comment
- . S COM=0
- . F S COM=$O(^LR(LRDFN,"MI",IX,12,TBIEN,1,COM)) Q:COM'>0 S ^TMP("ORM",$J,RPT,SS,"RPT",TBIEN,"COM",COM)=^(COM,0)
- . ;Susceptiblities
- . S GMTB=2
- . F S GMTB=$O(^LR(LRDFN,"MI",IX,12,ISO,GMTB)) Q:GMTB'["2."!(GMTB="") D
- . . S GMTBA=+$O(^DD(63.39,"GL",GMTB,1,0))
- . . S GMTBA=$$GET1^DID(63.39,GMTBA,"","LABEL")
- . . S ^TMP("ORM",$J,RPT,SS,"RPT",TBIEN,GMTB)=GMTBA_U_$P(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
- ; remark
- S RMK=0
- F S RMK=$O(^LR(LRDFN,"MI",IX,13,RMK)) Q:RMK="" S ^TMP("ORM",$J,RPT,SS,"IMP","TB","RMK",RMK)=^(RMK,0)
- Q
- MYCB N QTY
- S QTY=$P(^(0),U,2),MB=$P(^LAB(61.2,TBIEN,0),U)
- S MB=MB_U_QTY
- Q
- VIRO ; Gets Virology Work-up
- N BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS,VIROIEN
- I $D(^LR(LRDFN,"MI",IX,16)) D
- . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=34,DIQ="STATUS"
- . S DIQ(0)="E" D EN^DIQ1
- . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,34,"E")," ",1),1,6)
- S ISO=0
- F S ISO=$O(^LR(LRDFN,"MI",IX,17,ISO)) Q:+ISO'>0 D
- . S VIROIEN=+^LR(LRDFN,"MI",IX,17,ISO,0)
- . D PHAGE S ^TMP("ORM",$J,RPT,SS,"RPT",VIROIEN)="V"_U_$S($D(EXPAND):ISO_";"_BUG,1:BUG)
- S RMK=0
- F S RMK=$O(^LR(LRDFN,"MI",IX,18,RMK)) Q:RMK="" S ^TMP("ORM",$J,RPT,SS,"IMP","VIRO","RMK",RMK)=^(RMK,0)
- Q
- PHAGE S BUG=$P(^LAB(61.2,VIROIEN,0),U)
- Q
- ORDV05X ; slc/jdl - Microbiology Extended Extracts ;6/13/2001 11:59AM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,208**;Dec 17, 1997
- +2 ;;Called from ORDV05E, return ^TMP("ORM",$J in GCPR format
- +3 ;;For Parasitology,Mycology,Mycobacteriology,Virology in GCPR
- PARA ; Get Parasitology Work-up
- +1 NEW DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM,PARAIEN
- +2 IF $DATA(^LR(LRDFN,"MI",IX,5))
- Begin DoDot:1
- +3 SET DIC=63
- SET DA=LRDFN
- SET DA(63.05)=IX
- SET DR=5
- SET DR(63.05)=15
- SET DIQ="STATUS"
- +4 SET DIQ(0)="E"
- DO EN^DIQ1
- +5 SET ^TMP("ORM",$JOB,RPT,SS)=^TMP("ORM",$JOB,RPT,SS)_U_$EXTRACT($PIECE(STATUS(63.05,IX,15,"E")," ",1),1,6)
- End DoDot:1
- +6 SET PN=0
- +7 FOR
- SET PN=$ORDER(^LR(LRDFN,"MI",IX,6,PN))
- IF +PN'>0
- QUIT
- Begin DoDot:1
- +8 SET PARAIEN=+^LR(LRDFN,"MI",IX,6,PN,0)
- SET SN=0
- +9 DO IDPARA
- +10 FOR
- SET SN=$ORDER(^LR(LRDFN,"MI",IX,6,PN,1,SN))
- IF +SN'>0
- QUIT
- DO IDPARA
- End DoDot:1
- +11 ; Parasitology smear/prep
- +12 SET SMEAR=0
- +13 FOR
- SET SMEAR=$ORDER(^LR(LRDFN,"MI",IX,24,SMEAR))
- IF SMEAR'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"IMP","PARA","SMEAR",SMEAR)=^(SMEAR,0)
- +14 ; remark
- +15 SET RMK=0
- +16 FOR
- SET RMK=$ORDER(^LR(LRDFN,"MI",IX,7,RMK))
- IF +RMK'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"IMP","PARA","RMK",RMK)=^(RMK,0)
- +17 QUIT
- IDPARA ;Get parasite stage, quantity, and comment
- +1 NEW DA,DIC,DIQ,DR,PARA,STAGE
- +2 IF 'SN
- SET PARA=$SELECT($DATA(EXPAND):PN_";"_$PIECE(^LAB(61.2,PARAIEN,0),U),1:$PIECE(^LAB(61.2,PARAIEN,0),U))
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",PARAIEN)="P"_U_PARA
- QUIT
- +3 SET DA=LRDFN
- SET DA(63.05)=IX
- SET DA(63.34)=PN
- SET DA(63.35)=SN
- SET DIC=63
- SET DIQ="STAGE"
- SET DIQ(0)="E"
- SET DR=5
- SET DR(63.05)=16
- SET DR(63.34)=1
- SET DR(63.35)=".01;1"
- DO EN^DIQ1
- +4 SET ^TMP("ORM",$JOB,RPT,SS,"RPT",PARAIEN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
- +5 ;comment
- +6 SET COM=0
- +7 FOR
- SET COM=$ORDER(^LR(LRDFN,"MI",IX,6,PN,1,SN,1,COM))
- IF COM'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",PARAIEN,SN,COM)=^(COM,0)
- +8 QUIT
- MYCO ; Get Mycology Work-up
- +1 NEW DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR,MYCOIEN
- +2 IF $DATA(^LR(LRDFN,"MI",IX,8))
- Begin DoDot:1
- +3 SET DIC=63
- SET DA=LRDFN
- SET DA(63.05)=IX
- SET DR=5
- SET DR(63.05)=19
- SET DIQ="STATUS"
- +4 SET DIQ(0)="E"
- DO EN^DIQ1
- +5 SET ^TMP("ORM",$JOB,RPT,SS)=^TMP("ORM",$JOB,RPT,SS)_U_$EXTRACT($PIECE(STATUS(63.05,IX,19,"E")," ",1),1,6)
- End DoDot:1
- +6 SET ISO=0
- +7 FOR
- SET ISO=$ORDER(^LR(LRDFN,"MI",IX,9,ISO))
- IF +ISO'>0
- QUIT
- Begin DoDot:1
- +8 SET MYCOIEN=+^LR(LRDFN,"MI",IX,9,ISO,0)
- +9 DO FNGS
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",MYCOIEN)="M"_U_$SELECT($DATA(EXPAND):ISO_";"_FUN,1:FUN)
- +10 ;comment
- +11 SET COM=0
- +12 FOR
- SET COM=$ORDER(^LR(LRDFN,"MI",IX,9,ISO,1,COM))
- IF COM'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",MYCOIEN,"COM",COM)=^(COM,0)
- End DoDot:1
- +13 ; Mycology smear/prep
- +14 SET SMEAR=0
- +15 FOR
- SET SMEAR=$ORDER(^LR(LRDFN,"MI",IX,15,SMEAR))
- IF SMEAR'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"IMP","MYCO","SMEAR",SMEAR)=^(SMEAR,0)
- +16 ; remark
- +17 SET RMK=0
- +18 FOR
- SET RMK=$ORDER(^LR(LRDFN,"MI",IX,10,RMK))
- IF +RMK'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"IMP","MYCO","RMK",RMK)=^(RMK,0)
- +19 QUIT
- FNGS NEW QTY
- +1 SET FUN=+^LR(LRDFN,"MI",IX,9,ISO,0)
- SET QTY=$PIECE(^(0),U,2)
- SET FUN=$PIECE(^LAB(61.2,FUN,0),U)
- +2 SET FUN=FUN_U_QTY
- +3 QUIT
- TB ; Gets Mycobacteriology Work-up
- +1 NEW DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,Y,COM,MY,GMTB,GMTBA,TBIEN
- +2 IF $DATA(^LR(LRDFN,"MI",IX,11))
- Begin DoDot:1
- +3 SET DIC=63
- SET DA=LRDFN
- SET DA(63.05)=IX
- SET DR=5
- SET DR(63.05)="23;24;25"
- SET DIQ="STATUS"
- +4 SET DIQ(0)="E"
- DO EN^DIQ1
- +5 ;Status, Acid Fast Stain, Quantity
- +6 SET ^TMP("ORM",$JOB,RPT,SS)=^TMP("ORM",$JOB,RPT,SS)_U_$EXTRACT($PIECE(STATUS(63.05,IX,23,"E")," ",1),1,6)
- +7 SET ^TMP("ORM",$JOB,RPT,SS,"IMP","TB","ACID FAST STAIN")=STATUS(63.05,IX,24,"E")_U_STATUS(63.05,IX,25,"E")
- End DoDot:1
- +8 SET ISO=0
- +9 FOR
- SET ISO=$ORDER(^LR(LRDFN,"MI",IX,12,ISO))
- IF +ISO'>0
- QUIT
- Begin DoDot:1
- +10 SET TBIEN=+^LR(LRDFN,"MI",IX,12,ISO,0)
- +11 DO MYCB
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",TBIEN)="TB"_U_$SELECT($DATA(EXPAND):ISO_";"_MB,1:MB)
- +12 ;comment
- +13 SET COM=0
- +14 FOR
- SET COM=$ORDER(^LR(LRDFN,"MI",IX,12,TBIEN,1,COM))
- IF COM'>0
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",TBIEN,"COM",COM)=^(COM,0)
- +15 ;Susceptiblities
- +16 SET GMTB=2
- +17 FOR
- SET GMTB=$ORDER(^LR(LRDFN,"MI",IX,12,ISO,GMTB))
- IF GMTB'["2."!(GMTB="")
- QUIT
- Begin DoDot:2
- +18 SET GMTBA=+$ORDER(^DD(63.39,"GL",GMTB,1,0))
- +19 SET GMTBA=$$GET1^DID(63.39,GMTBA,"","LABEL")
- +20 SET ^TMP("ORM",$JOB,RPT,SS,"RPT",TBIEN,GMTB)=GMTBA_U_$PIECE(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
- End DoDot:2
- End DoDot:1
- +21 ; remark
- +22 SET RMK=0
- +23 FOR
- SET RMK=$ORDER(^LR(LRDFN,"MI",IX,13,RMK))
- IF RMK=""
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"IMP","TB","RMK",RMK)=^(RMK,0)
- +24 QUIT
- MYCB NEW QTY
- +1 SET QTY=$PIECE(^(0),U,2)
- SET MB=$PIECE(^LAB(61.2,TBIEN,0),U)
- +2 SET MB=MB_U_QTY
- +3 QUIT
- VIRO ; Gets Virology Work-up
- +1 NEW BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS,VIROIEN
- +2 IF $DATA(^LR(LRDFN,"MI",IX,16))
- Begin DoDot:1
- +3 SET DIC=63
- SET DA=LRDFN
- SET DA(63.05)=IX
- SET DR=5
- SET DR(63.05)=34
- SET DIQ="STATUS"
- +4 SET DIQ(0)="E"
- DO EN^DIQ1
- +5 SET ^TMP("ORM",$JOB,RPT,SS)=^TMP("ORM",$JOB,RPT,SS)_U_$EXTRACT($PIECE(STATUS(63.05,IX,34,"E")," ",1),1,6)
- End DoDot:1
- +6 SET ISO=0
- +7 FOR
- SET ISO=$ORDER(^LR(LRDFN,"MI",IX,17,ISO))
- IF +ISO'>0
- QUIT
- Begin DoDot:1
- +8 SET VIROIEN=+^LR(LRDFN,"MI",IX,17,ISO,0)
- +9 DO PHAGE
- SET ^TMP("ORM",$JOB,RPT,SS,"RPT",VIROIEN)="V"_U_$SELECT($DATA(EXPAND):ISO_";"_BUG,1:BUG)
- End DoDot:1
- +10 SET RMK=0
- +11 FOR
- SET RMK=$ORDER(^LR(LRDFN,"MI",IX,18,RMK))
- IF RMK=""
- QUIT
- SET ^TMP("ORM",$JOB,RPT,SS,"IMP","VIRO","RMK",RMK)=^(RMK,0)
- +12 QUIT
- PHAGE SET BUG=$PIECE(^LAB(61.2,VIROIEN,0),U)
- +1 QUIT
