- LRDRAW ;DALOI/CJS/RLM-WARD COLLECTION SUMMARY ;8/11/97
- ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
- ;;5.2;LAB SERVICE;**121,190,272,369**;Sep 27, 1994;Build 2
- ; Reference to ^%DT supported by DBIA #10003
- ; Reference to $$FMTE^XLFDT supported by IA #10103
- ; Reference to $$NOW^XLFDT supported by IA #10103
- ; Reference to ^DIC supported by IA #10007
- ; Reference to ^SC( supported by DBIA #908
- ; Reference to ^VA(200 supported by DBIA #10060
- BEGIN S %DT="AE" D ^%DT Q:Y<1 S U="^",%ZIS="Q",LRODT=+Y D FNDLOC Q:LRLLOC[U S ZTRTN="GO^LRDRAW" D IO^LRWU
- END K DIC,%ZIS,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,LRDC,LRDFN,LRDPF,LRIOZERO,LRLWC,LRSN,PNM,SSN,Z
- K HRCN ; IHS/OIT/MKK - LR*5.2*1030
- Q
- GO ; S:$D(ZTQUEUED) ZTREQ="@" U IO S LRDC=0 W @IOF,!,"List of Patients with Lab Orders",?40,"Order Date: "_$$FMTE^XLFDT(LRODT,""),!
- ; W ?2,"Date/Time Printed: "_$$FMTE^XLFDT($$NOW^XLFDT,""),!
- ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030 - Putting back IHS mods
- S Y=LRODT D DD^LRX S LRDDT=Y ;IHS/ANMC/CLS 11/1/95
- S:$D(ZTQUEUED) ZTREQ="@" U IO S LRDC=0 W @IOF,!,"LIST OF PATIENTS WITH LAB ORDERS ON",! D STAMP^LRX W ! ;IHS/ANMC/CLS 11/1/95
- ; ----- END IHS/OIT/MKK - LR*5.2*1030
- I LRLLOC="" F I=0:0 S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC="" D ORD
- I LRLLOC'="" D ORD
- I 'LRDC W !!,"REPORT EMPTY."
- W !,"Report Completed",!
- Q
- ORD S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1 D:'$D(^LRO(69,LRODT,1,LRSN,1))&$D(^LRO(69,LRODT,1,LRSN,0)) PRNT
- Q
- PRNT S LRDFN=+^LRO(69,LRODT,1,LRSN,0),LRLWC=$P(^(0),U,4),LRDC=1
- S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
- ; W !!,PNM,?30,SSN,?50,"ORDER NUMBER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):+^(.1),1:"?"),!,"LOCATION: ",LRLLOC,?50,$S(LRLWC="SP":"SEND PATIENT",LRLWC="WC":"WARD COLLECT",LRLWC="LC":"LAB COLLECT",1:"")
- W !!,PNM,?30,HRCN,?50,"ORDER NUMBER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):+^(.1),1:"?"),!,"LOCATION: ",LRLLOC,?50,$S(LRLWC="SP":"SEND PATIENT",LRLWC="WC":"WARD COLLECT",LRLWC="LC":"LAB COLLECT",1:"") ; IHS/OIT/MKK LR*5.2*1030
- W !,"TESTS: " S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 S X=^(I,0) W ?9,$P(^LAB(60,+X,0),U,1) W:$P(X,"^",11) ?30," Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^") W !
- Q
- FNDLOC ;return a location from ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN), from LRNODRQW, LRPHEXPT, LRPHITEM
- LOOP S LRLLOC="" W !,$S($D(DIC("A")):DIC("A"),1:"Select PATIENT LOCATION: ")
- R "ALL// ",X:DTIME G:'$T LEND S:X="" X="ALL" S:X="ALL"!(X="all") X="" S LRLLOC=X Q:X="" I $L(X) G LEND:X["^",LALL:X["?"!(X'?.ANP)
- I $L(X)<2!($L(X)>30) W " Enter 2 - 30 alpha-numeric name" G LOOP
- I $D(^LRO(69,LRODT,1,"AC",X)) S LRLLOC=X K %,X,Y Q
- S DIC=44,DIC(0)="EMOZ",DIC("S")="I $L($P(^(0),U,2)),$D(^LRO(69,LRODT,1,""AC"",$P(^(0),U,2)))" D ^DIC K DIC
- I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G LOOP
- I Y>0 S LRLLOC=$P(Y(0),U,2) I $D(^LRO(69,LRODT,1,"AC",LRLLOC)) K %,X,Y Q
- I '$D(^LRO(69,LRODT,1,"AC",LRLLOC)) W !,"["_LRLLOC_"] is not a valid entry",$C(7),! G LOOP
- SOME S Y=$O(^LRO(69,LRODT,1,"AC",X)) G LALL:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC)
- S %=$O(^LRO(69,LRODT,1,"AC",Y)) I $E(%,1,$L(LRLLOC))'=LRLLOC W $E(Y,$L(LRLLOC)+1,$L(Y)) S LRLLOC=Y K %,Y,X Q
- K % S Y=X F %=1:1 S Y=$O(^LRO(69,LRODT,1,"AC",Y)) Q:Y=""!($E(Y,1,$L(LRLLOC))'=LRLLOC) S %(%)=Y W !,?5,%,?9,Y I '(%#10) R !,"Press ""^"" to quit ",X:DTIME S:'$T X="^" Q:X["^"
- S %=%-1 W !,"CHOOSE 1-",%,": " R X:DTIME G:'$T LOOP G LALL:X["?" G LOOP:X["^"!(X="")
- I X\1'=+X!(X<1)!(X>%) W " ??",$C(7),! G LOOP
- S LRLLOC=%(X) K %,X,Y Q
- LALL S X="?",DIC=44,DIC(0)="EMOQ",DIC("S")="I $L($P(^(0),U,2)),$D(^LRO(69,LRODT,1,""AC"",$P(^(0),U,2)))" D ^DIC K DIC
- S Y="" W !,"YOU MAY ALSO CHOOSE FROM:" F %=1:1 S Y=$O(^LRO(69,LRODT,1,"AC",Y)) Q:Y="" D
- . I '$D(^SC("C",Y)) W !,?3,Y I '(%#10) R !,"Press ""^"" to quit ",X:DTIME S:'$T X="^" Q:X["^"
- G LOOP
- LEND K %,X,Y S LRLLOC="^" Q
- LRDRAW ;DALOI/CJS/RLM-WARD COLLECTION SUMMARY ;8/11/97
- +1 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
- +2 ;;5.2;LAB SERVICE;**121,190,272,369**;Sep 27, 1994;Build 2
- +3 ; Reference to ^%DT supported by DBIA #10003
- +4 ; Reference to $$FMTE^XLFDT supported by IA #10103
- +5 ; Reference to $$NOW^XLFDT supported by IA #10103
- +6 ; Reference to ^DIC supported by IA #10007
- +7 ; Reference to ^SC( supported by DBIA #908
- +8 ; Reference to ^VA(200 supported by DBIA #10060
- BEGIN SET %DT="AE"
- DO ^%DT
- IF Y<1
- QUIT
- SET U="^"
- SET %ZIS="Q"
- SET LRODT=+Y
- DO FNDLOC
- IF LRLLOC[U
- QUIT
- SET ZTRTN="GO^LRDRAW"
- DO IO^LRWU
- END KILL DIC,%ZIS,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,LRDC,LRDFN,LRDPF,LRIOZERO,LRLWC,LRSN,PNM,SSN,Z
- +1 ; IHS/OIT/MKK - LR*5.2*1030
- KILL HRCN
- +2 QUIT
- GO ; S:$D(ZTQUEUED) ZTREQ="@" U IO S LRDC=0 W @IOF,!,"List of Patients with Lab Orders",?40,"Order Date: "_$$FMTE^XLFDT(LRODT,""),!
- +1 ; W ?2,"Date/Time Printed: "_$$FMTE^XLFDT($$NOW^XLFDT,""),!
- +2 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030 - Putting back IHS mods
- +3 ;IHS/ANMC/CLS 11/1/95
- SET Y=LRODT
- DO DD^LRX
- SET LRDDT=Y
- +4 ;IHS/ANMC/CLS 11/1/95
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- USE IO
- SET LRDC=0
- WRITE @IOF,!,"LIST OF PATIENTS WITH LAB ORDERS ON",!
- DO STAMP^LRX
- WRITE !
- +5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
- +6 IF LRLLOC=""
- FOR I=0:0
- SET LRLLOC=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC))
- IF LRLLOC=""
- QUIT
- DO ORD
- +7 IF LRLLOC'=""
- DO ORD
- +8 IF 'LRDC
- WRITE !!,"REPORT EMPTY."
- +9 WRITE !,"Report Completed",!
- +10 QUIT
- ORD SET LRSN=0
- FOR
- SET LRSN=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN))
- IF LRSN<1
- QUIT
- IF '$DATA(^LRO(69,LRODT,1,LRSN,1))&$DATA(^LRO(69,LRODT,1,LRSN,0))
- DO PRNT
- +1 QUIT
- PRNT SET LRDFN=+^LRO(69,LRODT,1,LRSN,0)
- SET LRLWC=$PIECE(^(0),U,4)
- SET LRDC=1
- +1 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- DO PT^LRX
- +2 ; W !!,PNM,?30,SSN,?50,"ORDER NUMBER: ",$S($D(^LRO(69,LRODT,1,LRSN,.1)):+^(.1),1:"?"),!,"LOCATION: ",LRLLOC,?50,$S(LRLWC="SP":"SEND PATIENT",LRLWC="WC":"WARD COLLECT",LRLWC="LC":"LAB COLLECT",1:"")
- +3 ; IHS/OIT/MKK LR*5.2*1030
- WRITE !!,PNM,?30,HRCN,?50,"ORDER NUMBER: ",$SELECT($DATA(^LRO(69,LRODT,1,LRSN,.1)):+^(.1),1:"?"),!,"LOCATION: ",LRLLOC,?50,$SELECT(LRLWC="SP":"SEND PATIENT",LRLWC="WC":"WARD COLLECT",LRLWC="LC":"LAB COLLECT",1:"")
- +4 WRITE !,"TESTS: "
- SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,I))
- IF I<1
- QUIT
- SET X=^(I,0)
- WRITE ?9,$PIECE(^LAB(60,+X,0),U,1)
- IF $PIECE(X,"^",11)
- WRITE ?30," Canceled by: "_$PIECE(^VA(200,$PIECE(X,"^",11),0),"^")
- WRITE !
- +5 QUIT
- FNDLOC ;return a location from ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN), from LRNODRQW, LRPHEXPT, LRPHITEM
- LOOP SET LRLLOC=""
- WRITE !,$SELECT($DATA(DIC("A")):DIC("A"),1:"Select PATIENT LOCATION: ")
- +1 READ "ALL// ",X:DTIME
- IF '$TEST
- GOTO LEND
- IF X=""
- SET X="ALL"
- IF X="ALL"!(X="all")
- SET X=""
- SET LRLLOC=X
- IF X=""
- QUIT
- IF $LENGTH(X)
- IF X["^"
- GOTO LEND
- IF X["?"!(X'?.ANP)
- GOTO LALL
- +2 IF $LENGTH(X)<2!($LENGTH(X)>30)
- WRITE " Enter 2 - 30 alpha-numeric name"
- GOTO LOOP
- +3 IF $DATA(^LRO(69,LRODT,1,"AC",X))
- SET LRLLOC=X
- KILL %,X,Y
- QUIT
- +4 SET DIC=44
- SET DIC(0)="EMOZ"
- SET DIC("S")="I $L($P(^(0),U,2)),$D(^LRO(69,LRODT,1,""AC"",$P(^(0),U,2)))"
- DO ^DIC
- KILL DIC
- +5 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL DTOUT,DUOUT
- GOTO LOOP
- +6 IF Y>0
- SET LRLLOC=$PIECE(Y(0),U,2)
- IF $DATA(^LRO(69,LRODT,1,"AC",LRLLOC))
- KILL %,X,Y
- QUIT
- +7 IF '$DATA(^LRO(69,LRODT,1,"AC",LRLLOC))
- WRITE !,"["_LRLLOC_"] is not a valid entry",$CHAR(7),!
- GOTO LOOP
- SOME SET Y=$ORDER(^LRO(69,LRODT,1,"AC",X))
- IF Y=""!($EXTRACT(Y,1,$LENGTH(LRLLOC))'=LRLLOC)
- GOTO LALL
- +1 SET %=$ORDER(^LRO(69,LRODT,1,"AC",Y))
- IF $EXTRACT(%,1,$LENGTH(LRLLOC))'=LRLLOC
- WRITE $EXTRACT(Y,$LENGTH(LRLLOC)+1,$LENGTH(Y))
- SET LRLLOC=Y
- KILL %,Y,X
- QUIT
- +2 KILL %
- SET Y=X
- FOR %=1:1
- SET Y=$ORDER(^LRO(69,LRODT,1,"AC",Y))
- IF Y=""!($EXTRACT(Y,1,$LENGTH(LRLLOC))'=LRLLOC)
- QUIT
- SET %(%)=Y
- WRITE !,?5,%,?9,Y
- IF '(%#10)
- READ !,"Press ""^"" to quit ",X:DTIME
- IF '$TEST
- SET X="^"
- IF X["^"
- QUIT
- +3 SET %=%-1
- WRITE !,"CHOOSE 1-",%,": "
- READ X:DTIME
- IF '$TEST
- GOTO LOOP
- IF X["?"
- GOTO LALL
- IF X["^"!(X="")
- GOTO LOOP
- +4 IF X\1'=+X!(X<1)!(X>%)
- WRITE " ??",$CHAR(7),!
- GOTO LOOP
- +5 SET LRLLOC=%(X)
- KILL %,X,Y
- QUIT
- LALL SET X="?"
- SET DIC=44
- SET DIC(0)="EMOQ"
- SET DIC("S")="I $L($P(^(0),U,2)),$D(^LRO(69,LRODT,1,""AC"",$P(^(0),U,2)))"
- DO ^DIC
- KILL DIC
- +1 SET Y=""
- WRITE !,"YOU MAY ALSO CHOOSE FROM:"
- FOR %=1:1
- SET Y=$ORDER(^LRO(69,LRODT,1,"AC",Y))
- IF Y=""
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^SC("C",Y))
- WRITE !,?3,Y
- IF '(%#10)
- READ !,"Press ""^"" to quit ",X:DTIME
- IF '$TEST
- SET X="^"
- IF X["^"
- QUIT
- End DoDot:1
- +3 GOTO LOOP
- LEND KILL %,X,Y
- SET LRLLOC="^"
- QUIT
