- LRNDLST ;VA/SLC/CJS - PRINT LIST OF NON-DRAW ORDERS ;JUL 06, 2010 3:14 PM;
- ;;5.2;LAB SERVICE;**7,13,351,1027**;NOV 01, 1997
- S %DT="AE" D ^%DT Q:Y<1 S U="^",LRODT=+Y,LRLLOC="",%ZIS="Q" W !!?10," You may enter 'ALL' as a response",! D FNDLOC^LRDRAW G END:LRLLOC["^"
- S LRBEG=1
- S %ZIS="QN" D ^%ZIS G:POP END I IO=IO(0) G GO
- K IO("Q") S ZTDESC="LONG FORM NO DRAW LIST",ZTIO=ION,ZTRTN="EN^LRNDLST",ZTSAVE("LRODT")="",ZTSAVE("LRLLOC")="",ZTSAVE("LRBEG")="" D ^%ZTLOAD W !!?10,"Report Queued to device "_ION,!
- END K LROUT,DX(0),S,ZTSK
- ; K DIRUT,J,%DT,%,A,I,K,LRDC,LRSN,X,Y,Z,DIC,%ZIS,LRBECAUS,LRCOMB,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,%H,%X,%Y,DFN,LRDFN,LRDPF,LRIOZERO,LRLWC,PNM,POP,SSN D ^%ZISC
- ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
- K DIRUT,J,%DT,%,A,I,K,LRDC,LRSN,X,Y,Z,DIC,%ZIS,LRBECAUS,LRCOMB,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,%H,%X,%Y,DFN,LRDFN,LRDPF,LRIOZERO,LRLWC,PNM,POP,SSN
- K HRCN
- D ^%ZISC
- ; ----- END IHS/OIT/MKK - LR*5.2*1027
- Q
- % R %:DTIME S:'$T LROUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
- GO K X,DX,DR,DIC S DR="0:99",U="^",Y=LRODT,PG=1 D DD^LRX S (LROUT,LRDC)=0
- S DX(0)="I $E(IOST)=""C"" S S=$G(S)+1 I S>20 R ""'^' TO HALT: "",W:DTIME S:W=""^"" LROUT=1 S S=W'?1P W @IOF,!! I '$T S S=0,LROUT=1"
- I LRLLOC="" F S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC=""!(LROUT=1) S LRTOP=0,LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1!(LROUT=1) S LRDC=1 D ORD,PRNT
- I LRLLOC'=""&(LROUT=0) S LRTOP=0,LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN<1!(LROUT=1) S LRDC=1 D ORD,PRNT
- I 'LRDC W !,"REPORT EMPTY"
- W !,"Finished",! W:$E(IOST,1,2)="P-" @IOF
- S W="" R:'$G(LRBEG)&($E(IOST)="C") "Hit Enter to return to menu: ",W:DTIME
- D ^%ZISC,END Q
- ORD Q:$G(LROUT)
- I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),U,4)="C" Q
- I 'LRTOP S PG=1,W="" D
- .R:'$G(LRBEG)&($E(IOST)="C") "Enter to CONTINUE or '^' TO HALT: ",W:DTIME
- .S:W="^" LROUT=1 Q:$G(LROUT) W @IOF,!,"LIST OF PATIENT LAB ORDERS NOT DRAWN "_Y,!!!?10,"LISTING FOR ( ",LRLLOC," ) ",?50,"PG: ",PG,! S LRTOP=1 K LRBEG Q
- Q
- PRNT ;
- Q:$G(LROUT) N S
- I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),U,4)="C" Q
- I '$L($P(^LRO(69,LRODT,1,LRSN,0),U,4)) Q
- I $Y>$S($E(IOST)="C":18,1:60) S PG=PG+1 S W="" R:'$G(LRBEG)&($E(IOST)="C") "Enter to CONTINUE or '^' TO HALT: ",W:DTIME S:W="^" LROUT=1 Q:$G(LROUT) W @IOF,!!?10,"LISTING FOR ( ",LRLLOC," ) ",?50,"PG: ",PG,!
- S DIC="^LRO(69,"_LRODT_",1,",(DA,D0)=LRSN,S=$Y S:'$D(DTOUT) DTOUT=0 D EN^LRDIQ Q:$G(LROUT) S LROUT=$G(DIRUT) Q
- EN D GO W:$E(IOST,1,2)="P-" @IOF S:$D(ZTQUEUED) ZTREQ="@" Q
- Q
- LRNDLST ;VA/SLC/CJS - PRINT LIST OF NON-DRAW ORDERS ;JUL 06, 2010 3:14 PM;
- +1 ;;5.2;LAB SERVICE;**7,13,351,1027**;NOV 01, 1997
- +2 SET %DT="AE"
- DO ^%DT
- IF Y<1
- QUIT
- SET U="^"
- SET LRODT=+Y
- SET LRLLOC=""
- SET %ZIS="Q"
- WRITE !!?10," You may enter 'ALL' as a response",!
- DO FNDLOC^LRDRAW
- IF LRLLOC["^"
- GOTO END
- +3 SET LRBEG=1
- +4 SET %ZIS="QN"
- DO ^%ZIS
- IF POP
- GOTO END
- IF IO=IO(0)
- GOTO GO
- +5 KILL IO("Q")
- SET ZTDESC="LONG FORM NO DRAW LIST"
- SET ZTIO=ION
- SET ZTRTN="EN^LRNDLST"
- SET ZTSAVE("LRODT")=""
- SET ZTSAVE("LRLLOC")=""
- SET ZTSAVE("LRBEG")=""
- DO ^%ZTLOAD
- WRITE !!?10,"Report Queued to device "_ION,!
- END KILL LROUT,DX(0),S,ZTSK
- +1 ; K DIRUT,J,%DT,%,A,I,K,LRDC,LRSN,X,Y,Z,DIC,%ZIS,LRBECAUS,LRCOMB,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,%H,%X,%Y,DFN,LRDFN,LRDPF,LRIOZERO,LRLWC,PNM,POP,SSN D ^%ZISC
- +2 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
- +3 KILL DIRUT,J,%DT,%,A,I,K,LRDC,LRSN,X,Y,Z,DIC,%ZIS,LRBECAUS,LRCOMB,LRODT,LRLLOC,LRPGM,LRIO,LRTIME,%H,%X,%Y,DFN,LRDFN,LRDPF,LRIOZERO,LRLWC,PNM,POP,SSN
- +4 KILL HRCN
- +5 DO ^%ZISC
- +6 ; ----- END IHS/OIT/MKK - LR*5.2*1027
- +7 QUIT
- % READ %:DTIME
- IF '$TEST
- SET LROUT=1
- IF %=""!(%["N")!(%["Y")
- QUIT
- WRITE !,"Answer 'Y' or 'N': "
- GOTO %
- GO KILL X,DX,DR,DIC
- SET DR="0:99"
- SET U="^"
- SET Y=LRODT
- SET PG=1
- DO DD^LRX
- SET (LROUT,LRDC)=0
- +1 SET DX(0)="I $E(IOST)=""C"" S S=$G(S)+1 I S>20 R ""'^' TO HALT: "",W:DTIME S:W=""^"" LROUT=1 S S=W'?1P W @IOF,!! I '$T S S=0,LROUT=1"
- +2 IF LRLLOC=""
- FOR
- SET LRLLOC=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC))
- IF LRLLOC=""!(LROUT=1)
- QUIT
- SET LRTOP=0
- SET LRSN=0
- FOR
- SET LRSN=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN))
- IF LRSN<1!(LROUT=1)
- QUIT
- SET LRDC=1
- DO ORD
- DO PRNT
- +3 IF LRLLOC'=""&(LROUT=0)
- SET LRTOP=0
- SET LRSN=0
- FOR
- SET LRSN=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN))
- IF LRSN<1!(LROUT=1)
- QUIT
- SET LRDC=1
- DO ORD
- DO PRNT
- +4 IF 'LRDC
- WRITE !,"REPORT EMPTY"
- +5 WRITE !,"Finished",!
- IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- +6 SET W=""
- IF '$GET(LRBEG)&($EXTRACT(IOST)="C")
- READ "Hit Enter to return to menu: ",W:DTIME
- +7 DO ^%ZISC
- DO END
- QUIT
- ORD IF $GET(LROUT)
- QUIT
- +1 IF $DATA(^LRO(69,LRODT,1,LRSN,1))
- IF $PIECE(^(1),U,4)="C"
- QUIT
- +2 IF 'LRTOP
- SET PG=1
- SET W=""
- Begin DoDot:1
- +3 IF '$GET(LRBEG)&($EXTRACT(IOST)="C")
- READ "Enter to CONTINUE or '^' TO HALT: ",W:DTIME
- +4 IF W="^"
- SET LROUT=1
- IF $GET(LROUT)
- QUIT
- WRITE @IOF,!,"LIST OF PATIENT LAB ORDERS NOT DRAWN "_Y,!!!?10,"LISTING FOR ( ",LRLLOC," ) ",?50,"PG: ",PG,!
- SET LRTOP=1
- KILL LRBEG
- QUIT
- End DoDot:1
- +5 QUIT
- PRNT ;
- +1 IF $GET(LROUT)
- QUIT
- NEW S
- +2 IF $DATA(^LRO(69,LRODT,1,LRSN,1))
- IF $PIECE(^(1),U,4)="C"
- QUIT
- +3 IF '$LENGTH($PIECE(^LRO(69,LRODT,1,LRSN,0),U,4))
- QUIT
- +4 IF $Y>$SELECT($EXTRACT(IOST)="C":18,1:60)
- SET PG=PG+1
- SET W=""
- IF '$GET(LRBEG)&($EXTRACT(IOST)="C")
- READ "Enter to CONTINUE or '^' TO HALT: ",W:DTIME
- IF W="^"
- SET LROUT=1
- IF $GET(LROUT)
- QUIT
- WRITE @IOF,!!?10,"LISTING FOR ( ",LRLLOC," ) ",?50,"PG: ",PG,!
- +5 SET DIC="^LRO(69,"_LRODT_",1,"
- SET (DA,D0)=LRSN
- SET S=$Y
- IF '$DATA(DTOUT)
- SET DTOUT=0
- DO EN^LRDIQ
- IF $GET(LROUT)
- QUIT
- SET LROUT=$GET(DIRUT)
- QUIT
- EN DO GO
- IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +1 QUIT
