| 1 | LRLABLDS ;DALOI/FHS/DRH - PRINT SINGLE LABELS ON DEMAND FOR FUTURE LAB COLLECT ;8/29/94 12:36
|
|---|
| 2 | ;;5.2;LAB SERVICE;**161,218**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | N DIC,DIR,DIRUT,DTOUT,DTOUT,LRBATCH,LROK
|
|---|
| 5 | K ^TMP($J)
|
|---|
| 6 | S LRBATCH=0,LRPICK=2,LRSING=1
|
|---|
| 7 | S DIR(0)="NO^1:"_$O(^LRO(69,"C",""),-1)_":0",DIR("A")="Enter Order Number"
|
|---|
| 8 | S DIR("?")="Enter the order number for which you need a label"
|
|---|
| 9 | D ^DIR
|
|---|
| 10 | I $D(DIRUT) D CLEAN Q
|
|---|
| 11 | I '$D(^LRO(69,"C",Y)) W !?10,"Number does not exist",!,$C(7) G EN
|
|---|
| 12 | S LRORDN=Y
|
|---|
| 13 | GET K DA
|
|---|
| 14 | S (LREND,LROK,LRSN)=0
|
|---|
| 15 | S LRODT=$O(^LRO(69,"C",LRORDN,""))
|
|---|
| 16 | F S LRSN=$O(^LRO(69,"C",LRORDN,LRODT,LRSN)) Q:LRSN="" D
|
|---|
| 17 | . S LRSN(0)=$G(^LRO(69,LRODT,1,LRSN,0)),LRSN(1)=$G(^LRO(69,LRODT,1,LRSN,1))
|
|---|
| 18 | . S DA=LRSN,DA(1)=LRODT,DIC="^LRO(69,"_DA(1)_",1,"
|
|---|
| 19 | . D EN^DIQ,CHK
|
|---|
| 20 | . I 'LREND S LROK=1
|
|---|
| 21 | I 'LROK G EN
|
|---|
| 22 | K DIR W !
|
|---|
| 23 | S DIR(0)="YO",DIR("A")="Is this the correct patient",DIR("B")="YES"
|
|---|
| 24 | D ^DIR
|
|---|
| 25 | I $D(DIRUT) D CLEAN Q
|
|---|
| 26 | I Y'=1 G EN
|
|---|
| 27 | K %ZIS S %ZIS="Q" D ^%ZIS
|
|---|
| 28 | I POP D CLEAN Q
|
|---|
| 29 | I $D(IO("Q")) D G EN
|
|---|
| 30 | . S ZTRTN="QUE^LRLABLDS",ZTDESC="Print Future Collection Labels"
|
|---|
| 31 | . S ZTSAVE("LR*")=""
|
|---|
| 32 | . D ^%ZTLOAD,CLEAN
|
|---|
| 33 | QUE ;
|
|---|
| 34 | U IO
|
|---|
| 35 | S (LREND,LROK,LRSN)=0
|
|---|
| 36 | F S LRSN=$O(^LRO(69,"C",LRORDN,LRODT,LRSN)) Q:LRSN="" D
|
|---|
| 37 | . S LRSN(0)=$G(^LRO(69,LRODT,1,LRSN,0)),LRSN(1)=$G(^LRO(69,LRODT,1,LRSN,1))
|
|---|
| 38 | . I '$D(ZTQUEUED) S LROK=1
|
|---|
| 39 | . E D CHK S:'LREND LROK=1 Q:LREND
|
|---|
| 40 | . S LRDFN=+LRSN(0) D BLDTMP^LRLABLD0
|
|---|
| 41 | I LROK D ^LRLABELF
|
|---|
| 42 | Q:$D(ZTQUEUED)
|
|---|
| 43 | D CLEAN
|
|---|
| 44 | G EN
|
|---|
| 45 | ;
|
|---|
| 46 | CHK ; Check order for collection type/status/date-time
|
|---|
| 47 | N LRMSG
|
|---|
| 48 | S LREND=0
|
|---|
| 49 | I '$L($P(LRSN(0),U,4)) S LREND=1,LRMSG="No Collection Type on Order"
|
|---|
| 50 | I 'LREND,'$P(LRSN(0),U,8) S LREND=1,LRMSG="No Est. Date/Time of Collection on Order"
|
|---|
| 51 | I 'LREND,$L($P(LRSN(1),U,4)),"CM"[$P(LRSN(1),U,4) S LREND=1,LRMSG="Collection status: "_$$EXTERNAL^DILFD(69.01,13,,$P(LRSN(1),U,4))
|
|---|
| 52 | I 'LREND,$P(LRSN(1),U) S LREND=1,LRMSG="Order already collected"
|
|---|
| 53 | I 'LREND D
|
|---|
| 54 | . N LRTEST,LROK
|
|---|
| 55 | . S LROK=0 ; Flag to indicate there are still tests on the order
|
|---|
| 56 | . S LRTEST=0
|
|---|
| 57 | . F S LRTEST=$O(^LRO(69,LRODT,1,LRSN,2,LRTEST)) Q:'LRTEST I '$P($G(^LRO(69,LRODT,1,LRSN,2,LRTEST,0)),U,11) S LROK=1 ; Found a 'good' test.
|
|---|
| 58 | . I 'LROK S LREND=1,LRMSG="No active tests on specimen"
|
|---|
| 59 | I LREND,'LRBATCH D Q
|
|---|
| 60 | . I $D(ZTQUEUED),LRPICK=2 Q ; Don't print error msg on label printer.
|
|---|
| 61 | . U IO(0)
|
|---|
| 62 | . W !,$C(7),"Can not print label for Order Number: ",$P($G(^LRO(69,LRODT,1,LRSN,.1),"Unknown"),U)
|
|---|
| 63 | . W !,?26,"Specimen #: ",LRSN
|
|---|
| 64 | . W !,?5,"Reason - ",LRMSG,!
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | CLEAN ;
|
|---|
| 68 | D END^LRLABELF
|
|---|
| 69 | K DA,DIC,A,DX
|
|---|
| 70 | Q
|
|---|
