| 1 | LRORDIM ;DALCIOFO/FHS - PROCESS IMMEDIATE LAB COLLECT ALLOWABLE COLLECTION TIMES ;11/24/98 | 
|---|
| 2 | ;;5.2;LAB SERVICE;**75,201,213**;Sep 27, 1994 | 
|---|
| 3 | EN N D1 K LRCDT,LRODT,LRORDTIM | 
|---|
| 4 | W !!?25 | 
|---|
| 5 | S X="NOW",%DT="ET",Z="0000" | 
|---|
| 6 | W @LRVIDO | 
|---|
| 7 | D ^%DT W "  "_$$DOW^XLFDT(Y),@LRVIDOF | 
|---|
| 8 | W !! | 
|---|
| 9 | S I=$O(^LAB(69.9,1,7,DUZ(2),0)) | 
|---|
| 10 | I '$L(I) W !,"SERVICE NOT AVAILABLE",! G END | 
|---|
| 11 | S NODE=$G(^LAB(69.9,1,7,DUZ(2),0)) | 
|---|
| 12 | I '$L(NODE) W !,"SERVICE NOT AVAILABLE ",! G END | 
|---|
| 13 | W !!,?25,$S('$P(NODE,U,2):"NO ",1:"")_"COLLECTION ON HOLIDAYS ",! | 
|---|
| 14 | F I="SUN","MON","TUE","WED","THU","FRI","SAT" D | 
|---|
| 15 | . I $D(^LAB(69.9,1,7,DUZ(2),I)) S X=^(I) | 
|---|
| 16 | . I  W !,I_" Collection Between: " | 
|---|
| 17 | . I  S X1=$E(Z,($L(+$P(X,U,2))+1),4)_$P(X,U,2) | 
|---|
| 18 | . I  S X2=$E(Z,($L(+$P(X,U,3))+1),4)_$P(X,U,3) | 
|---|
| 19 | . I  S X3=$E(X1,1,2)_":"_$E(X1,3,4) | 
|---|
| 20 | . I  S X4=$E(X2,1,2)_":"_$E(X2,3,4) | 
|---|
| 21 | . I  W ?30,X3_"  and  ",X4 | 
|---|
| 22 | W !! K %DT S %DT("A")="Enter Collection Time: ",%DT="AET" D ^%DT | 
|---|
| 23 | G:Y<1 END I '$L($P(Y,".",2)) W !,"YOU MUST ALSO ENTER COLLECTION TIME",! G EN | 
|---|
| 24 | I '$P(NODE,U,2),$D(^HOLIDAY($P(Y,"."))) W $C(7),!!,"SORRY SERVICE NOT OFFERED ON "_$P($G(^($P(Y,"."),0)),U,2),! G EN | 
|---|
| 25 | K H,S S (LRCDT,X)=Y,M=$P(NODE,U,4),D=$$NOW^XLFDT() D DATE | 
|---|
| 26 | I LRCDT'>NOW1 W !!,"MUST BE "_M_" MINUTES IN THE FUTURE",!!,$C(7) G EN | 
|---|
| 27 | K M,S S H=$S($P(NODE,U,5):$P(NODE,U,5),1:24) D DATE I LRCDT>NOW1 W !!,"MUST BE LESS THAN "_H_" HRS IN THE FUTURE",!!,$C(7) G EN | 
|---|
| 28 | CHK ; | 
|---|
| 29 | S DAY=$E($$DOW^XLFDT(LRCDT),1,3) ; Get the day of the week | 
|---|
| 30 | S DAY=$$UP^XLFSTR(DAY) ; Convert to all Uppercase for compatibility | 
|---|
| 31 | S NODE1=$G(^LAB(69.9,1,7,DUZ(2),DAY)),NOP=0,X2=$P(LRCDT,".",2),X2=X2_$E("0000",($L(X2)+1),4) | 
|---|
| 32 | S:'$L(NODE1)!('$P(NODE1,U)) NOP=1 I NOP=1 W !,"SERVICE NOT OFFERED ON "_DAY,!!,$C(7) G EN | 
|---|
| 33 | I NOP=0 S:X2<$P(NODE1,U,2)!(X2>$P(NODE1,U,3)) NOP=2 I NOP=2 D DIS1 G EN | 
|---|
| 34 | I 'NOP W !!?10,"DATE/TIME ACCEPTED",!! | 
|---|
| 35 | S LRODT=$P(LRCDT,"."),LRORDTIM=$P(LRCDT,".",2) | 
|---|
| 36 | K %A,%DT,%H,%T,D,D1,DAY,H,I,M,NODE,NODE1,NOP,NOW1,S,X,X2,Y,Z Q | 
|---|
| 37 | END ; | 
|---|
| 38 | K LRCDT,%A,%DT,%H,%T,D,D1,DAY,H,I,M,NODE,NODE1,NOP,NOW1,S,X,X2,Y,Z Q  ; | 
|---|
| 39 | DATE ; | 
|---|
| 40 | I '$G(D) Q | 
|---|
| 41 | S D1=+$G(D1),H=+$G(H),M=+$G(M),S=+$G(S) | 
|---|
| 42 | S %H=$$FMTH^XLFDT(D),%T=$P(%H,",",2),%H=$P(%H,",") | 
|---|
| 43 | S %H=%H+D1,%T=(%T+(H*3600)+(M*60)+S) | 
|---|
| 44 | S %A=%T\86400 | 
|---|
| 45 | S:%A %H=%H+%A,%T=(%T-(86400*%A)) | 
|---|
| 46 | S NOW1=$$HTFM^XLFDT(%H_","_%T) | 
|---|
| 47 | Q | 
|---|
| 48 | DIS1 W !!!,$C(7),"SERVICE FOR ["_DAY_"] OFFERED BETWEEN "_$E(Z,($L(+$P(NODE1,U,2))+1),4)_$P(NODE1,U,2)_" AND "_$E(Z,($L(+$P(NODE1,U,3))+1),4)_$P(NODE1,U,3)_" Hrs ",! Q | 
|---|
| 49 | Q | 
|---|