- LRMIPSZ3 ; IHS/DIR/FJE - MICRO PATIENT REPORT - STERILITY, PARASITES, VIRUS 6/22/87 16:15 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- STER ;from LRMIPSZ1
- W:$L($P(^LR(LRDFN,"MI",LRIDT,1),U,7)) !,"STERILITY CONTROL: ",$S($P(^(1),U,7)="N":"NEGATIVE",1:"POSITIVE")
- S DIC="^LR("_LRDFN_",""MI"",",DA=LRIDT,DR=31 D EN^DIQ S:$D(DTOUT)!($D(DUOUT)) LREND=1
- Q
- PARA ;from LRMIPSZ1
- I '$L($P(^LR(LRDFN,"MI",LRIDT,5),U)) Q:'$D(LRWRDVEW) Q:LRSB'=5
- S LRTUS=$P(^LR(LRDFN,"MI",LRIDT,5),U,2),DZ=$P(^(5),U,3),Y=$P(^(5),U) D D^LRU
- W:LRHC ! W !,"* PARASITOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
- S LRPRE=21 D PRE^LRMIPSU
- I $D(^LR(LRDFN,"MI",LRIDT,24)) W:LRHC ! W !,"PARASITOLOGY SMEAR/PREP:" S LRMYC=0 F I=0:0 S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,24,LRMYC)) Q:LRMYC<1 W !?5,^(LRMYC,0)
- S LRPAR=0 F I=0:0 S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,6,LRPAR)) Q:LRPAR<1 W:LRHC ! W !,"Parasite: ",$E($P(^LAB(61.2,^(LRPAR,0),0),U),1,25),?30," " D STG
- I $D(^LR(LRDFN,"MI",LRIDT,7,0)),$P(^(0),U,4)>0 W:LRHC ! W !,"Parasitology Remark(s):" S LRPAR=0 F I=0:0 S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,7,LRPAR)) Q:LRPAR<1 W !,?3,^(LRPAR,0)
- Q
- STG S LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,6,LRPAR,0),S1=6,LRTA=LRPAR
- I $D(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,0)) S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B)) Q:B<1 S Y=^(B,0),Y1=$P(Y,U,2) W !," Stage: " D SET W:$L(Y1) !," Quantity: ",Y1 D LIST1
- Q
- SET S LRSET=$P(^DD(63.35,.01,0),U,3),%=$P($P(";"_LRSET,";"_$P(Y,U)_":",2),";") W:%]"" %
- Q
- LIST1 W !," Comment: " S C=0 F I=0:0 S C=+$O(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C)) Q:C<1 W ?13,^(C,0),!
- Q
- VIR ;from LRMIPSZ1
- I '$L($P(^LR(LRDFN,"MI",LRIDT,16),U)) Q:'$D(LRWRDVEW) Q:LRSB'=16
- S LRTUS=$P(^LR(LRDFN,"MI",LRIDT,16),U,2),DZ=$P(^(16),U,3),Y=$P(^(16),U) D D^LRU
- W:LRHC ! W !,"* VIROLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
- S LRPRE=20 D PRE^LRMIPSU
- S LRPAR=0 F I=0:0 S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,17,LRPAR)) Q:LRPAR<1 W:LRHC ! W !,"Virus: ",$P(^LAB(61.2,$P(^(LRPAR,0),U),0),U) S LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,17,LRPAR,0)
- I $D(^LR(LRDFN,"MI",LRIDT,18,0)),$P(^(0),U,4)>0 W:LRHC ! W !,"Virology Remark(s):" S LRPAR=0 F I=0:0 S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,18,LRPAR)) Q:LRPAR<1 W !,?3,^(LRPAR,0)
- Q
- LRMIPSZ3 ; IHS/DIR/FJE - MICRO PATIENT REPORT - STERILITY, PARASITES, VIRUS 6/22/87 16:15 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- STER ;from LRMIPSZ1
- +1 IF $LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,1),U,7))
- WRITE !,"STERILITY CONTROL: ",$SELECT($PIECE(^(1),U,7)="N":"NEGATIVE",1:"POSITIVE")
- +2 SET DIC="^LR("_LRDFN_",""MI"","
- SET DA=LRIDT
- SET DR=31
- DO EN^DIQ
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET LREND=1
- +3 QUIT
- PARA ;from LRMIPSZ1
- +1 IF '$LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,5),U))
- IF '$DATA(LRWRDVEW)
- QUIT
- IF LRSB'=5
- QUIT
- +2 SET LRTUS=$PIECE(^LR(LRDFN,"MI",LRIDT,5),U,2)
- SET DZ=$PIECE(^(5),U,3)
- SET Y=$PIECE(^(5),U)
- DO D^LRU
- +3 IF LRHC
- WRITE !
- WRITE !,"* PARASITOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
- +4 SET LRPRE=21
- DO PRE^LRMIPSU
- +5 IF $DATA(^LR(LRDFN,"MI",LRIDT,24))
- IF LRHC
- WRITE !
- WRITE !,"PARASITOLOGY SMEAR/PREP:"
- SET LRMYC=0
- FOR I=0:0
- SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,24,LRMYC))
- IF LRMYC<1
- QUIT
- WRITE !?5,^(LRMYC,0)
- +6 SET LRPAR=0
- FOR I=0:0
- SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,6,LRPAR))
- IF LRPAR<1
- QUIT
- IF LRHC
- WRITE !
- WRITE !,"Parasite: ",$EXTRACT($PIECE(^LAB(61.2,^(LRPAR,0),0),U),1,25),?30," "
- DO STG
- +7 IF $DATA(^LR(LRDFN,"MI",LRIDT,7,0))
- IF $PIECE(^(0),U,4)>0
- IF LRHC
- WRITE !
- WRITE !,"Parasitology Remark(s):"
- SET LRPAR=0
- FOR I=0:0
- SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,7,LRPAR))
- IF LRPAR<1
- QUIT
- WRITE !,?3,^(LRPAR,0)
- +8 QUIT
- STG SET LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,6,LRPAR,0)
- SET S1=6
- SET LRTA=LRPAR
- +1 IF $DATA(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,0))
- SET B=0
- FOR I=0:0
- SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B))
- IF B<1
- QUIT
- SET Y=^(B,0)
- SET Y1=$PIECE(Y,U,2)
- WRITE !," Stage: "
- DO SET
- IF $LENGTH(Y1)
- WRITE !," Quantity: ",Y1
- DO LIST1
- +2 QUIT
- SET SET LRSET=$PIECE(^DD(63.35,.01,0),U,3)
- SET %=$PIECE($PIECE(";"_LRSET,";"_$PIECE(Y,U)_":",2),";")
- IF %]""
- WRITE %
- +1 QUIT
- LIST1 WRITE !," Comment: "
- SET C=0
- FOR I=0:0
- SET C=+$ORDER(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C))
- IF C<1
- QUIT
- WRITE ?13,^(C,0),!
- +1 QUIT
- VIR ;from LRMIPSZ1
- +1 IF '$LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,16),U))
- IF '$DATA(LRWRDVEW)
- QUIT
- IF LRSB'=16
- QUIT
- +2 SET LRTUS=$PIECE(^LR(LRDFN,"MI",LRIDT,16),U,2)
- SET DZ=$PIECE(^(16),U,3)
- SET Y=$PIECE(^(16),U)
- DO D^LRU
- +3 IF LRHC
- WRITE !
- WRITE !,"* VIROLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y," TECH CODE: ",DZ
- +4 SET LRPRE=20
- DO PRE^LRMIPSU
- +5 SET LRPAR=0
- FOR I=0:0
- SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,17,LRPAR))
- IF LRPAR<1
- QUIT
- IF LRHC
- WRITE !
- WRITE !,"Virus: ",$PIECE(^LAB(61.2,$PIECE(^(LRPAR,0),U),0),U)
- SET LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,17,LRPAR,0)
- +6 IF $DATA(^LR(LRDFN,"MI",LRIDT,18,0))
- IF $PIECE(^(0),U,4)>0
- IF LRHC
- WRITE !
- WRITE !,"Virology Remark(s):"
- SET LRPAR=0
- FOR I=0:0
- SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,18,LRPAR))
- IF LRPAR<1
- QUIT
- WRITE !,?3,^(LRPAR,0)
- +7 QUIT
