GMTSLRM.m

GMTSLRM ; SLC/JER,KER - Microbiology Component Driver ; 09/21/2001

 ;;2.7;Health Summary;**28,47**;Oct 20, 1995

 ;

 ; External References

 ;    DBIA   525  ^LR( all fields

 ;    DBIA 10035  ^DPT( field 63 Read w/Fileman

 ;    DBIA  2056  $$GET1^DIQ (file 2)

 ;                         

MAIN ; Microbiology

 N IX0,IX,LRDFN,MAX,D1,D2,D3

 S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0  Q:'$D(^LR(LRDFN))

 Q:+($S('$D(^LR(LRDFN,"MI",0)):1,'$O(^LR(LRDFN,"MI",GMTS1)):1,$O(^(GMTS1))>GMTS2:1,1:0))

 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),IX=GMTS1

 F IX0=1:1:MAX S IX=$O(^LR(LRDFN,"MI",IX)) Q:+IX'>0!(IX>GMTS2)!$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)  D  Q:$D(GMTSQIT)

 . D ^GMTSLRME I $D(^TMP("LRM",$J)) D:IX0>1 CKP^GMTSUP Q:$D(GMTSQIT)  W:IX0>1 ! D INTRP

 . K ^TMP("LRM",$J)

 Q

INTRP ; Interprets ^TMP("LRM",$J

 N GMZ,GMK S (GMZ,GMK)=""

 F  S GMZ=$O(^TMP("LRM",$J,GMZ)) Q:GMZ=""  D RDNODE  Q:$D(GMTSQIT)

 Q

RDNODE ; Reads current node of ^TMP("LRM",$J

 N GMABX,COM S GMABX=0 I GMZ=0 D  Q

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?10,"Collected:",?21,$P(^TMP("LRM",$J,GMZ),U),?43,"Acc:",?48,$P(^TMP("LRM",$J,GMZ),U,2),!

 . I $P(^TMP("LRM",$J,GMZ),U,6)'=$P(^(GMZ),U,3) D

 . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?2,"Collection Sample:",?21,$P(^TMP("LRM",$J,GMZ),U,6),!

 . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?6,"Site/Specimen:",?21,$TR($P(^TMP("LRM",$J,GMZ),U,3),"|"," "),!

 . S COM=$P(^TMP("LRM",$J,GMZ),U,7)

 . I COM]"" D

 . . D CKP^GMTSUP Q:$D(GMTSQIT)

 . . W "Comment on Specimen:"

 . . I $L(COM)>58 S COM=$$WRAP^GMTSORC(COM,58)

 . . W ?21,$P(COM,"|"),!

 . . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?22,$P(COM,"|",2),!

 . D WRTTEST^GMTSLRM1

 S GMK="" F  S GMK=$O(^TMP("LRM",$J,GMZ,GMK)) Q:GMK=""  D WRTNODE Q:$D(GMTSQIT)

 Q

WRTNODE ; Writes current node of ^TMP("LRM",$J

 N GML,SMEAR,QTY,ORG,GMN,RSMEAR

 I GMZ="BSTER" D  Q

 . I GMK=0 D  Q

 . . Q:$P(^TMP("LRM",$J,"BSTER",GMK),U)']""

 . . D CKP^GMTSUP Q:$D(GMTSQIT)

 . .  W ?2,"Sterility Control:",?21,$P(^TMP("LRM",$J,"BSTER",GMK),U),! Q

 . D CKP^GMTSUP I $D(GMTSQIT)

 . W ?13,"Number:",?21,GMK,?34,"Sterility Results: ",$P(^TMP("LRM",$J,GMZ,GMK),U),!

 I GMK=0 S GMN=$G(^TMP("LRM",$J,GMZ,GMK)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?4,$S(GMZ="BACT":"    Bact ",GMZ="TB":"Mycobact ",GMZ="MYCO":"Mycology ",GMZ="PARA":"Parasite ",GMZ="VIRO":"Virology ",1:"         ")_"Report:",?21,$P(GMN,U),! D  Q

 . I GMZ="BACT" D  Q:$D(GMTSQIT)

 . . I $P(GMN,U,3)]"" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?7,"Urine Screen: ",$P(GMN,U,3),!

 . . I $P(GMN,U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?6,"Sputum Screen: ",$P(GMN,U,2),!

 . I GMZ="TB" D  Q:$D(GMTSQIT)

 . . I $P(GMN,U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT)  W ?4,"Acid Fast Stain: ",$E($P(GMN,U,2),1,20) D

 . . . S QTY=$P(GMN,U,3)

 . . . I $L(QTY)>35 S QTY=$$WRAP^GMTSORC(QTY,35)

 . . . W ?44,$P(QTY,"|"),!

 . . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?44,$P(QTY,"|",2),!

 I GMZ="GRAM" D WRTGRM^GMTSLRM1 Q

 I GMK="SMEAR" D  Q

 . D CKP^GMTSUP Q:$D(GMTSQIT)

 . W ?9,"Smear/Prep:"

 . S SMEAR=0

 . F  S SMEAR=$O(^TMP("LRM",$J,GMZ,GMK,SMEAR)) Q:SMEAR'>0  D  I +$O(^TMP("LRM",$J,GMK,SMEAR)) D CKP^GMTSUP Q:$D(GMTSQIT)

 . . S RSMEAR=^TMP("LRM",$J,GMZ,GMK,SMEAR)

 . . I $L(RSMEAR)>58 S RSMEAR=$$WRAP^GMTSORC(RSMEAR,58)

 . . W ?21,$P(RSMEAR,"|"),!

 . . I $L($P(RSMEAR,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?22,$P(RSMEAR,"|",2),!

 I GMK="R" D REMARKS^GMTSLRM1 Q

 I GMZ'="CABXL" D  Q:$D(GMTSQIT)

 . S ORG=$P(^TMP("LRM",$J,GMZ,GMK),U),QTY=$P(^(GMK),U,2)

 . I $L(ORG)>58 S ORG=$$WRAP^GMTSORC(ORG,58)

 . D CKP^GMTSUP Q:$D(GMTSQIT)

 . W ?11,"Organism:"

 . W ?21,$P(ORG,"|",1),!

 . I $L($P(ORG,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?23,$P(ORG,"|",2),!

 . I QTY]"" W ?11,"Quantity:" D

 . . I $L(QTY)>58 S QTY=$$WRAP^GMTSORC(QTY,58)

 . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?21,$P(QTY,"|"),!

 . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?23,$P(QTY,"|",2),!

 . D COMMENT^GMTSLRM1 Q:$D(GMTSQIT)

 . I GMZ="TB" D TBSUSC^GMTSLRM1

 I GMZ="CABXL" D

 . I GMK=1!(GMABX=1) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?8,"Ser Abx Lev:"

 . W ?21,$E($P(^TMP("LRM",$J,GMZ,GMK),U),1,20),?45,$$DRAW($P(^TMP("LRM",$J,GMZ,GMK),U,2)),?55,$P(^TMP("LRM",$J,GMZ,GMK),U,3)," ug/ml",! D CKP^GMTSUP Q:$D(GMTSQIT)

 I GMZ="BACT",$D(^TMP("LRM",$J,GMZ,GMK,"SUSC")) D ANTIBX^GMTSLRM1 Q

 I GMZ="PARA",$D(^TMP("LRM",$J,GMZ,GMK))=11 D

 . S GML=0

 . F  S GML=$O(^TMP("LRM",$J,GMZ,GMK,GML)) Q:GML'>0  D  Q:$D(GMTSQIT)

 . . D CKP^GMTSUP Q:$D(GMTSQIT)

 . . W ?23,$P(^TMP("LRM",$J,GMZ,GMK,GML),U)

 . . S QTY=$P(^TMP("LRM",$J,GMZ,GMK,GML),U,2)

 . . I $L(QTY)>34 S QTY=$$WRAP^GMTSORC(QTY,34)

 . . W ?45,$P(QTY,"|"),!

 . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?45,$P(QTY,"|",2),!

 . . D PARACOMM^GMTSLRM1

 Q

DRAW(CODE) ; Peak/Trough/Random Abx level

 Q $S(CODE="P":"PEAK",CODE="T":"TROUGH",1:"RANDOM")

GMTSLRM   ; SLC/JER,KER - Microbiology Component Driver ; 09/21/2001

 +1       ;;2.7;Health Summary;**28,47**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;    DBIA   525  ^LR( all fields

 +5       ;    DBIA 10035  ^DPT( field 63 Read w/Fileman

 +6       ;    DBIA  2056  $$GET1^DIQ (file 2)

 +7       ;                         

MAIN      ; Microbiology

 +1        NEW IX0,IX,LRDFN,MAX,D1,D2,D3

 +2        SET LRDFN=+($$GET1^DIQ(2,(+($GET(DFN))_","),63,"I"))

           IF +LRDFN=0

               QUIT 

           IF '$DATA(^LR(LRDFN))

               QUIT 

 +3        IF +($SELECT('$DATA(^LR(LRDFN,"MI",0))

               QUIT 

 +4        SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:999)

           SET IX=GMTS1

 +5        FOR IX0=1:1:MAX

               SET IX=$ORDER(^LR(LRDFN,"MI",IX))

               IF +IX'>0!(IX>GMTS2)!$DATA(GMTSQIT)

                   QUIT 

               DO CKP^GMTSUP

               IF $DATA(GMTSQIT)

                   QUIT 

               Begin DoDot:1

 +6                DO ^GMTSLRME

                   IF $DATA(^TMP("LRM",$JOB))

                       IF IX0>1

                           DO CKP^GMTSUP

                       IF $DATA(GMTSQIT)

                           QUIT 

                       IF IX0>1

                           WRITE !

                       DO INTRP

 +7                KILL ^TMP("LRM",$JOB)

               End DoDot:1

               IF $DATA(GMTSQIT)

                   QUIT 

 +8        QUIT 

INTRP     ; Interprets ^TMP("LRM",$J

 +1        NEW GMZ,GMK

           SET (GMZ,GMK)=""

 +2        FOR 

               SET GMZ=$ORDER(^TMP("LRM",$JOB,GMZ))

               IF GMZ=""

                   QUIT 

               DO RDNODE

               IF $DATA(GMTSQIT)

                   QUIT 

 +3        QUIT 

RDNODE    ; Reads current node of ^TMP("LRM",$J

 +1        NEW GMABX,COM

           SET GMABX=0

           IF GMZ=0

               Begin DoDot:1

 +2                DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

                       QUIT 

                   WRITE ?10,"Collected:",?21,$PIECE(^TMP("LRM",$JOB,GMZ),U),?43,"Acc:",?48,$PIECE(^TMP("LRM",$JOB,GMZ),U,2),!

 +3                IF $PIECE(^TMP("LRM",$JOB,GMZ),U,6)'=$PIECE(^(GMZ),U,3)

                       Begin DoDot:2

 +4                        DO CKP^GMTSUP

                           IF $DATA(GMTSQIT)

                               QUIT 

                           WRITE ?2,"Collection Sample:",?21,$PIECE(^TMP("LRM",$JOB,GMZ),U,6),!

                       End DoDot:2

 +5                DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

                       QUIT 

                   WRITE ?6,"Site/Specimen:",?21,$TRANSLATE($PIECE(^TMP("LRM",$JOB,GMZ),U,3),"|"," "),!

 +6                SET COM=$PIECE(^TMP("LRM",$JOB,GMZ),U,7)

 +7                IF COM]""

                       Begin DoDot:2

 +8                        DO CKP^GMTSUP

                           IF $DATA(GMTSQIT)

                               QUIT 

 +9                        WRITE "Comment on Specimen:"

 +10                       IF $LENGTH(COM)>58

                               SET COM=$$WRAP^GMTSORC(COM,58)

 +11                       WRITE ?21,$PIECE(COM,"|"),!

 +12                       IF $LENGTH($PIECE(COM,"|",2))

                               DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

                               WRITE ?22,$PIECE(COM,"|",2),!

                       End DoDot:2

 +13               DO WRTTEST^GMTSLRM1

               End DoDot:1

               QUIT 

 +14       SET GMK=""

           FOR 

               SET GMK=$ORDER(^TMP("LRM",$JOB,GMZ,GMK))

               IF GMK=""

                   QUIT 

               DO WRTNODE

               IF $DATA(GMTSQIT)

                   QUIT 

 +15       QUIT 

WRTNODE   ; Writes current node of ^TMP("LRM",$J

 +1        NEW GML,SMEAR,QTY,ORG,GMN,RSMEAR

 +2        IF GMZ="BSTER"

               Begin DoDot:1

 +3                IF GMK=0

                       Begin DoDot:2

 +4                        IF $PIECE(^TMP("LRM",$JOB,"BSTER",GMK),U)']""

                               QUIT 

 +5                        DO CKP^GMTSUP

                           IF $DATA(GMTSQIT)

                               QUIT 

 +6                        WRITE ?2,"Sterility Control:",?21,$PIECE(^TMP("LRM",$JOB,"BSTER",GMK),U),!

                           QUIT 

                       End DoDot:2

                       QUIT 

 +7                DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

 +8                WRITE ?13,"Number:",?21,GMK,?34,"Sterility Results: ",$PIECE(^TMP("LRM",$JOB,GMZ,GMK),U),!

               End DoDot:1

               QUIT 

 +9        IF GMK=0

               SET GMN=$GET(^TMP("LRM",$JOB,GMZ,GMK))

               DO CKP^GMTSUP

               IF $DATA(GMTSQIT)

                   QUIT 

               WRITE ?4,$SELECT(GMZ="BACT":"    Bact ",GMZ="TB":"Mycobact ",GMZ="MYCO":"Mycology ",GMZ="PARA":"Parasite ",GMZ="VIRO":"Virology ",1:"         ")_"Report:",?21,$PIECE(GMN,U),!

               Begin DoDot:1

 +10               IF GMZ="BACT"

                       Begin DoDot:2

 +11                       IF $PIECE(GMN,U,3)]""

                               DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

                               WRITE ?7,"Urine Screen: ",$PIECE(GMN,U,3),!

 +12                       IF $PIECE(GMN,U,2)]""

                               DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

                               WRITE ?6,"Sputum Screen: ",$PIECE(GMN,U,2),!

                       End DoDot:2

                       IF $DATA(GMTSQIT)

                           QUIT 

 +13               IF GMZ="TB"

                       Begin DoDot:2

 +14                       IF $PIECE(GMN,U,2)]""

                               DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

                               WRITE ?4,"Acid Fast Stain: ",$EXTRACT($PIECE(GMN,U,2),1,20)

                               Begin DoDot:3

 +15                               SET QTY=$PIECE(GMN,U,3)

 +16                               IF $LENGTH(QTY)>35

                                       SET QTY=$$WRAP^GMTSORC(QTY,35)

 +17                               WRITE ?44,$PIECE(QTY,"|"),!

 +18                               IF $LENGTH($PIECE(QTY,"|",2))

                                       DO CKP^GMTSUP

                                       IF $DATA(GMTSQIT)

                                           QUIT 

                                       WRITE ?44,$PIECE(QTY,"|",2),!

                               End DoDot:3

                       End DoDot:2

                       IF $DATA(GMTSQIT)

                           QUIT 

               End DoDot:1

               QUIT 

 +19       IF GMZ="GRAM"

               DO WRTGRM^GMTSLRM1

               QUIT 

 +20       IF GMK="SMEAR"

               Begin DoDot:1

 +21               DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

                       QUIT 

 +22               WRITE ?9,"Smear/Prep:"

 +23               SET SMEAR=0

 +24               FOR 

                       SET SMEAR=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,SMEAR))

                       IF SMEAR'>0

                           QUIT 

                       Begin DoDot:2

 +25                       SET RSMEAR=^TMP("LRM",$JOB,GMZ,GMK,SMEAR)

 +26                       IF $LENGTH(RSMEAR)>58

                               SET RSMEAR=$$WRAP^GMTSORC(RSMEAR,58)

 +27                       WRITE ?21,$PIECE(RSMEAR,"|"),!

 +28                       IF $LENGTH($PIECE(RSMEAR,"|",2))

                               DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

                               WRITE ?22,$PIECE(RSMEAR,"|",2),!

                       End DoDot:2

                       IF +$ORDER(^TMP("LRM",$JOB,GMK,SMEAR))

                           DO CKP^GMTSUP

                           IF $DATA(GMTSQIT)

                               QUIT 

               End DoDot:1

               QUIT 

 +29       IF GMK="R"

               DO REMARKS^GMTSLRM1

               QUIT 

 +30       IF GMZ'="CABXL"

               Begin DoDot:1

 +31               SET ORG=$PIECE(^TMP("LRM",$JOB,GMZ,GMK),U)

                   SET QTY=$PIECE(^(GMK),U,2)

 +32               IF $LENGTH(ORG)>58

                       SET ORG=$$WRAP^GMTSORC(ORG,58)

 +33               DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

                       QUIT 

 +34               WRITE ?11,"Organism:"

 +35               WRITE ?21,$PIECE(ORG,"|",1),!

 +36               IF $LENGTH($PIECE(ORG,"|",2))

                       DO CKP^GMTSUP

                       IF $DATA(GMTSQIT)

                           QUIT 

                       WRITE ?23,$PIECE(ORG,"|",2),!

 +37               IF QTY]""

                       WRITE ?11,"Quantity:"

                       Begin DoDot:2

 +38                       IF $LENGTH(QTY)>58

                               SET QTY=$$WRAP^GMTSORC(QTY,58)

 +39                       DO CKP^GMTSUP

                           IF $DATA(GMTSQIT)

                               QUIT 

                           WRITE ?21,$PIECE(QTY,"|"),!

 +40                       IF $LENGTH($PIECE(QTY,"|",2))

                               DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

                               WRITE ?23,$PIECE(QTY,"|",2),!

                       End DoDot:2

 +41               DO COMMENT^GMTSLRM1

                   IF $DATA(GMTSQIT)

                       QUIT 

 +42               IF GMZ="TB"

                       DO TBSUSC^GMTSLRM1

               End DoDot:1

               IF $DATA(GMTSQIT)

                   QUIT 

 +43       IF GMZ="CABXL"

               Begin DoDot:1

 +44               IF GMK=1!(GMABX=1)

                       DO CKP^GMTSUP

                       IF $DATA(GMTSQIT)

                           QUIT 

                       WRITE ?8,"Ser Abx Lev:"

 +45               WRITE ?21,$EXTRACT($PIECE(^TMP("LRM",$JOB,GMZ,GMK),U),1,20),?45,$$DRAW($PIECE(^TMP("LRM",$JOB,GMZ,GMK),U,2)),?55,$PIECE(^TMP("LRM",$JOB,GMZ,GMK),U,3)," ug/ml",!

                   DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

                       QUIT 

               End DoDot:1

 +46       IF GMZ="BACT"

               IF $DATA(^TMP("LRM",$JOB,GMZ,GMK,"SUSC"))

                   DO ANTIBX^GMTSLRM1

                   QUIT 

 +47       IF GMZ="PARA"

               IF $DATA(^TMP("LRM",$JOB,GMZ,GMK))=11

                   Begin DoDot:1

 +48                   SET GML=0

 +49                   FOR 

                           SET GML=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,GML))

                           IF GML'>0

                               QUIT 

                           Begin DoDot:2

 +50                           DO CKP^GMTSUP

                               IF $DATA(GMTSQIT)

                                   QUIT 

 +51                           WRITE ?23,$PIECE(^TMP("LRM",$JOB,GMZ,GMK,GML),U)

 +52                           SET QTY=$PIECE(^TMP("LRM",$JOB,GMZ,GMK,GML),U,2)

 +53                           IF $LENGTH(QTY)>34

                                   SET QTY=$$WRAP^GMTSORC(QTY,34)

 +54                           WRITE ?45,$PIECE(QTY,"|"),!

 +55                           IF $LENGTH($PIECE(QTY,"|",2))

                                   DO CKP^GMTSUP

                                   IF $DATA(GMTSQIT)

                                       QUIT 

                                   WRITE ?45,$PIECE(QTY,"|",2),!

 +56                           DO PARACOMM^GMTSLRM1

                           End DoDot:2

                           IF $DATA(GMTSQIT)

                               QUIT 

                   End DoDot:1

 +57       QUIT 

DRAW(CODE) ; Peak/Trough/Random Abx level

 +1        QUIT $SELECT(CODE="P":"PEAK",CODE="T":"TROUGH",1:"RANDOM")