- LAMIAUT6 ; IHS/DIR/FJE - DISPLAY MICRO DRUGS IN ORDER ; 22-Oct-2013 09:22 ; MKK
- ;;5.2;LA;**1002,1033**;NOV 01, 1997
- ;
- EN ;
- K LRCNODE S LRCNODE=^LAH(LRLL,1,LRIFN,3,IR,0),^(0)=$P(LRCNODE,U,1,2) Q:LREND
- I $L($P(LRCNODE,U,3)) F A=3:1:99 Q:'$L($P(LRCNODE,U,A)) I $O(^LAB(62.4,LRINST,7,$P(LRCNODE,U,A),2,0)) S LRCNODE($P(LRCNODE,U,A))=""
- I LRCNODE=""!('$O(LRCNODE(0))) G BLIND
- S (LREND,LRCARD)=0
- F A=1:1 S LRCARD=$O(LRCNODE(LRCARD)) Q:LREND!(LRCARD="") D HDR,AC R !,"RETURN TO CONT. ('^' TO SKIP ) ",XX:DTIME S:'$T!($E(XX)="^") LREND=1
- Q
- HDR W @IOF,!?5,"Isolate ("_IR_")",!?7,$P(^LAB(61.2,LRORGN,0),U)," *** ",$P(^LAB(62.4,LRINST,7,LRCARD,0),U,2)," Card ***"
- Q
- AC ;
- F IX=0:0 S IX=$O(^LAB(62.4,LRINST,7,LRCARD,2,"AC",IX)) Q:IX="" S IXI=$O(^LAB(62.4,LRINST,7,LRCARD,2,"AC",IX,0)) Q:IXI="" I $D(^LAB(62.4,LRINST,7,LRCARD,2,IXI,0)) S LRDRD=$P(^(0),U,2) D LOOK
- Q
- LOOK ;
- Q:'$D(^LAB(62.06,"AD",LRDRD)) I $D(^LAH(LRLL,1,LRIFN,3,IR,LRDRD)) S LRDRDX=^(LRDRD),LRDRNAME=$S($D(^LAB(62.06,+$O(^LAB(62.06,"AD",LRDRD,0)),0)):$P(^(0),U),1:"") I $L(LRDRNAME) W !,LRDRNAME," " F AA=1:1:3 W @(@("TAB"_AA)),$P(LRDRDX,U,AA)
- Q
- BLIND ;
- W @IOF,!!?5,"Isolate ( "_IR_" )",!?7,$P(^LAB(61.2,LRORGN,0),U),!!
- ; F LRDRD=2:0 S LRDRD=$O(^LAH(LRLL,1,LRIFN,3,IR,LRDRD)) Q:LRDRD="" D LOOK
- S LRDRD=2 F S LRDRD=$O(^LAH(LRLL,1,LRIFN,3,IR,LRDRD)) Q:LRDRD="" D LOOK ; IHS/MSC/MKK - LR*5.2*1033
- I $O(^LAH(LRLL,1,LRIFN,3,IR,1,0)) W !!,"Organism Comment:" F LRORGCOM=0:0 S LRORGCOM=$O(^LAH(LRLL,1,LRIFN,3,IR,1,LRORGCOM)) Q:LRORGCOM="" W !?10,^(LRORGCOM,0)
- K LRDRD R !!?7,"RETURN TO CONT. ('^' TO SKIP) ",XX:DTIME W ! S:$E(XX)="^" LREND=1
- K LRDRD
- Q
- COM ;
- Q:'$O(^LAH(LRLL,1,LRIFN,4,0)) W !!?5,"BACT RPT REMARK",$C(7) F LRSCOM=0:0 S LRSCOM=$O(^LAH(LRLL,1,LRIFN,4,LRSCOM)) Q:LRSCOM="" I $D(^(LRSCOM,0)) W !?10,^(0)
- R !!?10,"PRESS RETURN TO CONTINUE",X:DTIME W !
- Q
- Q
- DUP ;
- S SX=X,LREND=0 D ^LAMIAUT3 S X=SX K SX W !?5,"( No ) will add another organism",!?5,"( Yes ) will overlay existing data",!!
- W !?10,"You already have "_LRBDUP(+X)_" "_$S($D(^LAB(61.2,+X,0)):$P(^(0),U),1:"Unknown")_" in the patient's file, ",!,"Do you want to add data to one of Them ? "
- S %=2 D YN^DICN S:%<1 LREND=1 Q:LREND G:%=0 DUP I %=1 G DUPCK
- F II=1:1 Q:'$D(^LR(LRDFN,"MI",LRIDT,3,II))&('$D(^LAH(LRLL,1,LRIFN,3,II)))
- S LRMOVE(II)="A",LRORG=II,$P(^LR(LRDFN,"MI",LRIDT,3,0),U,3)=II,$P(^(0),U,4)=$P(^(0),U,4)+1 Q
- Q
- DUPCK ;
- I LRBDUP(X)=1 S LRORG=$O(LRBDUP(X,0)) G SWITCH
- W !?7,"Add to which ISOLATE # CHOOSE FROM ( " F K=0:0 S K=$O(LRBDUP(+X,K)) Q:K="" W K_" "
- W ") " S LREND=0 R LRORG:DTIME S:'$T!($E(LRORG)="^") LREND=1 Q:LREND
- I $E(LRORG)="?" G DUP
- I LRORG="" W !!?7,$C(7),"Please select a number or '^' ",! G DUPCK
- I '$D(LRBDUP(X,+LRORG)) W !!?10,$C(7)," NO SUCH ISOLATE # FOR THIS ORGANISM ",!! G DUPCK
- SWITCH ;
- I $D(LRMOVE(LRORG))!(^LAH(LRLL,1,LRIFN,3,IR,0)='LRORGN) W !!?10,"I am sorry, I cannot transfer to this Isolate, ",!," You must MANAULLY EDIT " S LREND=1 Q
- S LRMOVE(LRORG)="O"
- Q
- LAMIAUT6 ; IHS/DIR/FJE - DISPLAY MICRO DRUGS IN ORDER ; 22-Oct-2013 09:22 ; MKK
- +1 ;;5.2;LA;**1002,1033**;NOV 01, 1997
- +2 ;
- EN ;
- +1 KILL LRCNODE
- SET LRCNODE=^LAH(LRLL,1,LRIFN,3,IR,0)
- SET ^(0)=$PIECE(LRCNODE,U,1,2)
- IF LREND
- QUIT
- +2 IF $LENGTH($PIECE(LRCNODE,U,3))
- FOR A=3:1:99
- IF '$LENGTH($PIECE(LRCNODE,U,A))
- QUIT
- IF $ORDER(^LAB(62.4,LRINST,7,$PIECE(LRCNODE,U,A),2,0))
- SET LRCNODE($PIECE(LRCNODE,U,A))=""
- +3 IF LRCNODE=""!('$ORDER(LRCNODE(0)))
- GOTO BLIND
- +4 SET (LREND,LRCARD)=0
- +5 FOR A=1:1
- SET LRCARD=$ORDER(LRCNODE(LRCARD))
- IF LREND!(LRCARD="")
- QUIT
- DO HDR
- DO AC
- READ !,"RETURN TO CONT. ('^' TO SKIP ) ",XX:DTIME
- IF '$TEST!($EXTRACT(XX)="^")
- SET LREND=1
- +6 QUIT
- HDR WRITE @IOF,!?5,"Isolate ("_IR_")",!?7,$PIECE(^LAB(61.2,LRORGN,0),U)," *** ",$PIECE(^LAB(62.4,LRINST,7,LRCARD,0),U,2)," Card ***"
- +1 QUIT
- AC ;
- +1 FOR IX=0:0
- SET IX=$ORDER(^LAB(62.4,LRINST,7,LRCARD,2,"AC",IX))
- IF IX=""
- QUIT
- SET IXI=$ORDER(^LAB(62.4,LRINST,7,LRCARD,2,"AC",IX,0))
- IF IXI=""
- QUIT
- IF $DATA(^LAB(62.4,LRINST,7,LRCARD,2,IXI,0))
- SET LRDRD=$PIECE(^(0),U,2)
- DO LOOK
- +2 QUIT
- LOOK ;
- +1 IF '$DATA(^LAB(62.06,"AD",LRDRD))
- QUIT
- IF $DATA(^LAH(LRLL,1,LRIFN,3,IR,LRDRD))
- SET LRDRDX=^(LRDRD)
- SET LRDRNAME=$SELECT($DATA(^LAB(62.06,+$ORDER(^LAB(62.06,"AD",LRDRD,0)),0)):$PIECE(^(0),U),1:"")
- IF $LENGTH(LRDRNAME)
- WRITE !,LRDRNAME," "
- FOR AA=1:1:3
- WRITE @(@("TAB"_AA)),$PIECE(LRDRDX,U,AA)
- +2 QUIT
- BLIND ;
- +1 WRITE @IOF,!!?5,"Isolate ( "_IR_" )",!?7,$PIECE(^LAB(61.2,LRORGN,0),U),!!
- +2 ; F LRDRD=2:0 S LRDRD=$O(^LAH(LRLL,1,LRIFN,3,IR,LRDRD)) Q:LRDRD="" D LOOK
- +3 ; IHS/MSC/MKK - LR*5.2*1033
- SET LRDRD=2
- FOR
- SET LRDRD=$ORDER(^LAH(LRLL,1,LRIFN,3,IR,LRDRD))
- IF LRDRD=""
- QUIT
- DO LOOK
- +4 IF $ORDER(^LAH(LRLL,1,LRIFN,3,IR,1,0))
- WRITE !!,"Organism Comment:"
- FOR LRORGCOM=0:0
- SET LRORGCOM=$ORDER(^LAH(LRLL,1,LRIFN,3,IR,1,LRORGCOM))
- IF LRORGCOM=""
- QUIT
- WRITE !?10,^(LRORGCOM,0)
- +5 KILL LRDRD
- READ !!?7,"RETURN TO CONT. ('^' TO SKIP) ",XX:DTIME
- WRITE !
- IF $EXTRACT(XX)="^"
- SET LREND=1
- +6 KILL LRDRD
- +7 QUIT
- COM ;
- +1 IF '$ORDER(^LAH(LRLL,1,LRIFN,4,0))
- QUIT
- WRITE !!?5,"BACT RPT REMARK",$CHAR(7)
- FOR LRSCOM=0:0
- SET LRSCOM=$ORDER(^LAH(LRLL,1,LRIFN,4,LRSCOM))
- IF LRSCOM=""
- QUIT
- IF $DATA(^(LRSCOM,0))
- WRITE !?10,^(0)
- +2 READ !!?10,"PRESS RETURN TO CONTINUE",X:DTIME
- WRITE !
- +3 QUIT
- +4 QUIT
- DUP ;
- +1 SET SX=X
- SET LREND=0
- DO ^LAMIAUT3
- SET X=SX
- KILL SX
- WRITE !?5,"( No ) will add another organism",!?5,"( Yes ) will overlay existing data",!!
- +2 WRITE !?10,"You already have "_LRBDUP(+X)_" "_$SELECT($DATA(^LAB(61.2,+X,0)):$PIECE(^(0),U),1:"Unknown")_" in the patient's file, ",!,"Do you want to add data to one of Them ? "
- +3 SET %=2
- DO YN^DICN
- IF %<1
- SET LREND=1
- IF LREND
- QUIT
- IF %=0
- GOTO DUP
- IF %=1
- GOTO DUPCK
- +4 FOR II=1:1
- IF '$DATA(^LR(LRDFN,"MI",LRIDT,3,II))&('$DATA(^LAH(LRLL,1,LRIFN,3,II)))
- QUIT
- +5 SET LRMOVE(II)="A"
- SET LRORG=II
- SET $PIECE(^LR(LRDFN,"MI",LRIDT,3,0),U,3)=II
- SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
- QUIT
- +6 QUIT
- DUPCK ;
- +1 IF LRBDUP(X)=1
- SET LRORG=$ORDER(LRBDUP(X,0))
- GOTO SWITCH
- +2 WRITE !?7,"Add to which ISOLATE # CHOOSE FROM ( "
- FOR K=0:0
- SET K=$ORDER(LRBDUP(+X,K))
- IF K=""
- QUIT
- WRITE K_" "
- +3 WRITE ") "
- SET LREND=0
- READ LRORG:DTIME
- IF '$TEST!($EXTRACT(LRORG)="^")
- SET LREND=1
- IF LREND
- QUIT
- +4 IF $EXTRACT(LRORG)="?"
- GOTO DUP
- +5 IF LRORG=""
- WRITE !!?7,$CHAR(7),"Please select a number or '^' ",!
- GOTO DUPCK
- +6 IF '$DATA(LRBDUP(X,+LRORG))
- WRITE !!?10,$CHAR(7)," NO SUCH ISOLATE # FOR THIS ORGANISM ",!!
- GOTO DUPCK
- SWITCH ;
- +1 IF $DATA(LRMOVE(LRORG))!(^LAH(LRLL,1,LRIFN,3,IR,0)='LRORGN)
- WRITE !!?10,"I am sorry, I cannot transfer to this Isolate, ",!," You must MANAULLY EDIT "
- SET LREND=1
- QUIT
- +2 SET LRMOVE(LRORG)="O"
- +3 QUIT
