- LRORDIM ;DALCIOFO/FHS - PROCESS IMMEDIATE LAB COLLECT ALLOWABLE COLLECTION TIMES ;11/24/98 [ 04/10/2003 9:47 AM ]
- ;;5.2T9;LR;**1006,1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**75,201,213**;Sep 27, 1994
- EN N D1 K LRCDT,LRODT,LRORDTIM
- W !!?25
- S X="NOW",%DT="ET",Z="0000"
- W @LRVIDO
- D ^%DT W " "_$$DOW^XLFDT(Y),@LRVIDOF
- W !!
- ;----- BEGIN IHS MODIFICATION LR*5.2*1018
- ;S I=$O(^LAB(69.9,1,7,DUZ(2),0))
- ;I '$L(I) W !,"SERVICE NOT AVAILABLE",! G END
- ;----- END IHS MODIFICATION
- S NODE=$G(^LAB(69.9,1,7,DUZ(2),0))
- I '$L(NODE) W !,"SERVICE NOT AVAILABLE ",! G END
- W !!,?25,$S('$P(NODE,U,2):"NO ",1:"")_"COLLECTION ON HOLIDAYS ",!
- F I="SUN","MON","TUE","WED","THU","FRI","SAT" D
- . I $D(^LAB(69.9,1,7,DUZ(2),I)) S X=^(I)
- . I W !,I_" Collection Between: "
- . I S X1=$E(Z,($L(+$P(X,U,2))+1),4)_$P(X,U,2)
- . I S X2=$E(Z,($L(+$P(X,U,3))+1),4)_$P(X,U,3)
- . I S X3=$E(X1,1,2)_":"_$E(X1,3,4)
- . I S X4=$E(X2,1,2)_":"_$E(X2,3,4)
- . I W ?30,X3_" and ",X4
- W !! K %DT S %DT("A")="Enter Collection Time: ",%DT="AET" D ^%DT
- G:Y<1 END I '$L($P(Y,".",2)) W !,"YOU MUST ALSO ENTER COLLECTION TIME",! G EN
- 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
- K H,S S (LRCDT,X)=Y,M=$P(NODE,U,4),D=$$NOW^XLFDT() D DATE
- I LRCDT'>NOW1 W !!,"MUST BE "_M_" MINUTES IN THE FUTURE",!!,$C(7) G EN
- 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
- CHK ;
- S DAY=$E($$DOW^XLFDT(LRCDT),1,3) ; Get the day of the week
- S DAY=$$UP^XLFSTR(DAY) ; Convert to all Uppercase for compatibility
- 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)
- S:'$L(NODE1)!('$P(NODE1,U)) NOP=1 I NOP=1 W !,"SERVICE NOT OFFERED ON "_DAY,!!,$C(7) G EN
- I NOP=0 S:X2<$P(NODE1,U,2)!(X2>$P(NODE1,U,3)) NOP=2 I NOP=2 D DIS1 G EN
- I 'NOP W !!?10,"DATE/TIME ACCEPTED",!!
- S LRODT=$P(LRCDT,"."),LRORDTIM=$P(LRCDT,".",2)
- K %A,%DT,%H,%T,D,D1,DAY,H,I,M,NODE,NODE1,NOP,NOW1,S,X,X2,Y,Z Q
- END ;
- K LRCDT,%A,%DT,%H,%T,D,D1,DAY,H,I,M,NODE,NODE1,NOP,NOW1,S,X,X2,Y,Z Q ;
- DATE ;
- I '$G(D) Q
- S D1=+$G(D1),H=+$G(H),M=+$G(M),S=+$G(S)
- S %H=$$FMTH^XLFDT(D),%T=$P(%H,",",2),%H=$P(%H,",")
- S %H=%H+D1,%T=(%T+(H*3600)+(M*60)+S)
- S %A=%T\86400
- S:%A %H=%H+%A,%T=(%T-(86400*%A))
- S NOW1=$$HTFM^XLFDT(%H_","_%T)
- Q
- 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
- Q
- LRORDIM ;DALCIOFO/FHS - PROCESS IMMEDIATE LAB COLLECT ALLOWABLE COLLECTION TIMES ;11/24/98 [ 04/10/2003 9:47 AM ]
- +1 ;;5.2T9;LR;**1006,1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**75,201,213**;Sep 27, 1994
- EN NEW D1
- KILL LRCDT,LRODT,LRORDTIM
- +1 WRITE !!?25
- +2 SET X="NOW"
- SET %DT="ET"
- SET Z="0000"
- +3 WRITE @LRVIDO
- +4 DO ^%DT
- WRITE " "_$$DOW^XLFDT(Y),@LRVIDOF
- +5 WRITE !!
- +6 ;----- BEGIN IHS MODIFICATION LR*5.2*1018
- +7 ;S I=$O(^LAB(69.9,1,7,DUZ(2),0))
- +8 ;I '$L(I) W !,"SERVICE NOT AVAILABLE",! G END
- +9 ;----- END IHS MODIFICATION
- +10 SET NODE=$GET(^LAB(69.9,1,7,DUZ(2),0))
- +11 IF '$LENGTH(NODE)
- WRITE !,"SERVICE NOT AVAILABLE ",!
- GOTO END
- +12 WRITE !!,?25,$SELECT('$PIECE(NODE,U,2):"NO ",1:"")_"COLLECTION ON HOLIDAYS ",!
- +13 FOR I="SUN","MON","TUE","WED","THU","FRI","SAT"
- Begin DoDot:1
- +14 IF $DATA(^LAB(69.9,1,7,DUZ(2),I))
- SET X=^(I)
- +15 IF $TEST
- WRITE !,I_" Collection Between: "
- +16 IF $TEST
- SET X1=$EXTRACT(Z,($LENGTH(+$PIECE(X,U,2))+1),4)_$PIECE(X,U,2)
- +17 IF $TEST
- SET X2=$EXTRACT(Z,($LENGTH(+$PIECE(X,U,3))+1),4)_$PIECE(X,U,3)
- +18 IF $TEST
- SET X3=$EXTRACT(X1,1,2)_":"_$EXTRACT(X1,3,4)
- +19 IF $TEST
- SET X4=$EXTRACT(X2,1,2)_":"_$EXTRACT(X2,3,4)
- +20 IF $TEST
- WRITE ?30,X3_" and ",X4
- End DoDot:1
- +21 WRITE !!
- KILL %DT
- SET %DT("A")="Enter Collection Time: "
- SET %DT="AET"
- DO ^%DT
- +22 IF Y<1
- GOTO END
- IF '$LENGTH($PIECE(Y,".",2))
- WRITE !,"YOU MUST ALSO ENTER COLLECTION TIME",!
- GOTO EN
- +23 IF '$PIECE(NODE,U,2)
- IF $DATA(^HOLIDAY($PIECE(Y,".")))
- WRITE $CHAR(7),!!,"SORRY SERVICE NOT OFFERED ON "_$PIECE($GET(^($PIECE(Y,"."),0)),U,2),!
- GOTO EN
- +24 KILL H,S
- SET (LRCDT,X)=Y
- SET M=$PIECE(NODE,U,4)
- SET D=$$NOW^XLFDT()
- DO DATE
- +25 IF LRCDT'>NOW1
- WRITE !!,"MUST BE "_M_" MINUTES IN THE FUTURE",!!,$CHAR(7)
- GOTO EN
- +26 KILL M,S
- SET H=$SELECT($PIECE(NODE,U,5):$PIECE(NODE,U,5),1:24)
- DO DATE
- IF LRCDT>NOW1
- WRITE !!,"MUST BE LESS THAN "_H_" HRS IN THE FUTURE",!!,$CHAR(7)
- GOTO EN
- CHK ;
- +1 ; Get the day of the week
- SET DAY=$EXTRACT($$DOW^XLFDT(LRCDT),1,3)
- +2 ; Convert to all Uppercase for compatibility
- SET DAY=$$UP^XLFSTR(DAY)
- +3 SET NODE1=$GET(^LAB(69.9,1,7,DUZ(2),DAY))
- SET NOP=0
- SET X2=$PIECE(LRCDT,".",2)
- SET X2=X2_$EXTRACT("0000",($LENGTH(X2)+1),4)
- +4 IF '$LENGTH(NODE1)!('$PIECE(NODE1,U))
- SET NOP=1
- IF NOP=1
- WRITE !,"SERVICE NOT OFFERED ON "_DAY,!!,$CHAR(7)
- GOTO EN
- +5 IF NOP=0
- IF X2<$PIECE(NODE1,U,2)!(X2>$PIECE(NODE1,U,3))
- SET NOP=2
- IF NOP=2
- DO DIS1
- GOTO EN
- +6 IF 'NOP
- WRITE !!?10,"DATE/TIME ACCEPTED",!!
- +7 SET LRODT=$PIECE(LRCDT,".")
- SET LRORDTIM=$PIECE(LRCDT,".",2)
- +8 KILL %A,%DT,%H,%T,D,D1,DAY,H,I,M,NODE,NODE1,NOP,NOW1,S,X,X2,Y,Z
- QUIT
- END ;
- +1 ;
- KILL LRCDT,%A,%DT,%H,%T,D,D1,DAY,H,I,M,NODE,NODE1,NOP,NOW1,S,X,X2,Y,Z
- QUIT
- DATE ;
- +1 IF '$GET(D)
- QUIT
- +2 SET D1=+$GET(D1)
- SET H=+$GET(H)
- SET M=+$GET(M)
- SET S=+$GET(S)
- +3 SET %H=$$FMTH^XLFDT(D)
- SET %T=$PIECE(%H,",",2)
- SET %H=$PIECE(%H,",")
- +4 SET %H=%H+D1
- SET %T=(%T+(H*3600)+(M*60)+S)
- +5 SET %A=%T\86400
- +6 IF %A
- SET %H=%H+%A
- SET %T=(%T-(86400*%A))
- +7 SET NOW1=$$HTFM^XLFDT(%H_","_%T)
- +8 QUIT
- DIS1 WRITE !!!,$CHAR(7),"SERVICE FOR ["_DAY_"] OFFERED BETWEEN "_$EXTRACT(Z,($LENGTH(+$PIECE(NODE1,U,2))+1),4)_$PIECE(NODE1,U,2)_" AND "_$EXTRACT(Z,($LENGTH(+$PIECE(NODE1,U,3))+1),4)_$PIECE(NODE1,U,3)_" Hrs ",!
- QUIT
- +1 QUIT
