- LRBLDSC ;AVAMC/REG - DONOR SCHEDULING REPORT ;2/18/93 09:01
- ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
- W @IOF,!?10,"DONOR SCHEDULING REPORT BY DONATION OR DEFERRAL DATE"
- D B^LRU G:Y<0 END
- S ZTRTN="QUE^LRBLDSC" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO K ^TMP($J) S LRT=$P(^DD(65.54,1.1,0),U,3),LRD=$P(^DD(65.54,1,0),U,3),LRA=LRSDT-1 D L^LRU,S^LRU,H S LR("F")=1
- F LRA=LRA:0 S LRA=$O(^LRE("AD",LRA)) Q:'LRA!(LRA>LRLDT) S Y=LRA,LRIDT=9999999-LRA D I
- S (LR("N","S"),LR("W","S"),LR("W","S","A"),LR("W","S","H"),LR("W","S","T"),LR("W","S","D"),LR("P","S"),LR("C","S"))=0
- F LRA=0:0 S LRA=$O(^TMP($J,LRA)) Q:'LRA!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") S Y=LRA,LRIDT=9999999-LRSDT D DT^LRU W !!?2,"DONATION OR DEFERRAL DATE: ",Y S LRW=Y D W
- I 'LR("Q") W !!?5,"Total" S LRF=0 F A="N","W","P","C" Q:LR("Q") I LR(A,"S") W:LRF ! W ?11,$P($P(LRD,A_":",2),";"),?25,":",$J(LR(A,"S"),8) S LRF=1 D:$Y>(IOSL-6) H2 D:A="W" T
- D END^LRUTL,END Q
- W S (LR("N"),LR("W"),LR("W","A"),LR("W","H"),LR("W","T"),LR("W","D"),LR("P"),LR("C"))=0
- F LRB=-1:0 S LRB=$O(^TMP($J,LRA,LRB)) Q:LRB=""!(LR("Q")) F LRI=0:0 S LRI=$O(^TMP($J,LRA,LRB,LRI)) Q:'LRI!(LR("Q")) S LRE=^(LRI) D:$Y>(IOSL-6) H1 Q:LR("Q") D Y
- Q:LR("Q") D:$Y>(IOSL-6) H1
- W !?2,"Subtotal" S LRF=0 F A="N","W","P","C" Q:LR("Q") I LR(A) W:LRF ! W ?11,$P($P(LRD,A_":",2),";"),?25,":",$J(LR(A),8) S LRF=1 D:$Y>(IOSL-6) H1 D:A="W" B
- Q
- B F B="A","H","T","D" Q:LR("Q") I LR(A,B) W !?13,$P($P(LRT,B_":",2),";"),?24,":",$J(LR(A,B),3) D:$Y>(IOSL-6) H1
- Q
- Y S A=$P(LRE,"^",2),B=$P(LRE,"^",3) S LR(A)=LR(A)+1,LR(A,"S")=LR(A,"S")+1 I B]"",$D(LR(A,B)) S LR(A,B)=LR(A,B)+1,LR(A,"S",B)=LR(A,"S",B)+1
- S A=$P($P(LRD,A_":",2),";"),B=$P($P(LRT,B_":",2),";"),Y=$S(LRB:LRB,1:LRA) D DT^LRU W !,$S(Y[":":Y,1:Y_"??:??"),?15,$P(LRE,"^"),?28,A,?43,B,?54,$P(LRE,"^",4) Q
- I F LRI=0:0 S LRI=$O(^LRE("AD",LRA,LRI)) Q:'LRI!(LR("Q")) I $D(^LRE(LRI,5,LRIDT,0)) S X=^(0),A=+X,B=+$P(X,"^",13),^TMP($J,A,B,LRI)=$P(X,"^",4)_"^"_$P(X,"^",2)_"^"_$P(X,"^",11)_"^"_$P(X,"^",5)
- Q
- T F B="A","H","T","D" Q:LR("Q") I LR(A,"S",B) W !?13,$P($P(LRT,B_":",2),";"),?24,":",$J(LR(A,"S",B),4) D:$Y>(IOSL-6) H2
- Q
- ;
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,"DONOR SCHEDULING REPORT FROM ",LRSTR," TO ",LRLST
- W !,"ARRIVAL/APPT",?15,"UNIT ID",?28,"DON/DEF",?43,"DON. TYPE",?54,"PATIENT CREDIT",!,LR("%") Q
- H1 D H Q:LR("Q") W !!?2,"DONATION OR DEFERRAL DATE: ",LRW Q
- H2 D H Q:LR("Q") W !?2,"Total Count: " Q
- ;
- END D V^LRU Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLDSC 2605 printed Feb 18, 2025@23:36:47 Page 2
- LRBLDSC ;AVAMC/REG - DONOR SCHEDULING REPORT ;2/18/93 09:01
- +1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- +2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- +3 DO END
- SET X="BLOOD BANK"
- DO ^LRUTL
- if Y=-1
- GOTO END
- +4 WRITE @IOF,!?10,"DONOR SCHEDULING REPORT BY DONATION OR DEFERRAL DATE"
- +5 DO B^LRU
- if Y<0
- GOTO END
- +6 SET ZTRTN="QUE^LRBLDSC"
- DO BEG^LRUTL
- if POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- KILL ^TMP($JOB)
- SET LRT=$PIECE(^DD(65.54,1.1,0),U,3)
- SET LRD=$PIECE(^DD(65.54,1,0),U,3)
- SET LRA=LRSDT-1
- DO L^LRU
- DO S^LRU
- DO H
- SET LR("F")=1
- +1 FOR LRA=LRA:0
- SET LRA=$ORDER(^LRE("AD",LRA))
- if 'LRA!(LRA>LRLDT)
- QUIT
- SET Y=LRA
- SET LRIDT=9999999-LRA
- DO I
- +2 SET (LR("N","S"),LR("W","S"),LR("W","S","A"),LR("W","S","H"),LR("W","S","T"),LR("W","S","D"),LR("P","S"),LR("C","S"))=0
- +3 FOR LRA=0:0
- SET LRA=$ORDER(^TMP($JOB,LRA))
- if 'LRA!(LR("Q"))
- QUIT
- if $Y>(IOSL-6)
- DO H
- if LR("Q")
- QUIT
- SET Y=LRA
- SET LRIDT=9999999-LRSDT
- DO DT^LRU
- WRITE !!?2,"DONATION OR DEFERRAL DATE: ",Y
- SET LRW=Y
- DO W
- +4 IF 'LR("Q")
- WRITE !!?5,"Total"
- SET LRF=0
- FOR A="N","W","P","C"
- if LR("Q")
- QUIT
- IF LR(A,"S")
- if LRF
- WRITE !
- WRITE ?11,$PIECE($PIECE(LRD,A_":",2),";"),?25,":",$JUSTIFY(LR(A,"S"),8)
- SET LRF=1
- if $Y>(IOSL-6)
- DO H2
- if A="W"
- DO T
- +5 DO END^LRUTL
- DO END
- QUIT
- W SET (LR("N"),LR("W"),LR("W","A"),LR("W","H"),LR("W","T"),LR("W","D"),LR("P"),LR("C"))=0
- +1 FOR LRB=-1:0
- SET LRB=$ORDER(^TMP($JOB,LRA,LRB))
- if LRB=""!(LR("Q"))
- QUIT
- FOR LRI=0:0
- SET LRI=$ORDER(^TMP($JOB,LRA,LRB,LRI))
- if 'LRI!(LR("Q"))
- QUIT
- SET LRE=^(LRI)
- if $Y>(IOSL-6)
- DO H1
- if LR("Q")
- QUIT
- DO Y
- +2 if LR("Q")
- QUIT
- if $Y>(IOSL-6)
- DO H1
- +3 WRITE !?2,"Subtotal"
- SET LRF=0
- FOR A="N","W","P","C"
- if LR("Q")
- QUIT
- IF LR(A)
- if LRF
- WRITE !
- WRITE ?11,$PIECE($PIECE(LRD,A_":",2),";"),?25,":",$JUSTIFY(LR(A),8)
- SET LRF=1
- if $Y>(IOSL-6)
- DO H1
- if A="W"
- DO B
- +4 QUIT
- B FOR B="A","H","T","D"
- if LR("Q")
- QUIT
- IF LR(A,B)
- WRITE !?13,$PIECE($PIECE(LRT,B_":",2),";"),?24,":",$JUSTIFY(LR(A,B),3)
- if $Y>(IOSL-6)
- DO H1
- +1 QUIT
- Y SET A=$PIECE(LRE,"^",2)
- SET B=$PIECE(LRE,"^",3)
- SET LR(A)=LR(A)+1
- SET LR(A,"S")=LR(A,"S")+1
- IF B]""
- IF $DATA(LR(A,B))
- SET LR(A,B)=LR(A,B)+1
- SET LR(A,"S",B)=LR(A,"S",B)+1
- +1 SET A=$PIECE($PIECE(LRD,A_":",2),";")
- SET B=$PIECE($PIECE(LRT,B_":",2),";")
- SET Y=$SELECT(LRB:LRB,1:LRA)
- DO DT^LRU
- WRITE !,$SELECT(Y[":":Y,1:Y_"??:??"),?15,$PIECE(LRE,"^"),?28,A,?43,B,?54,$PIECE(LRE,"^",4)
- QUIT
- I FOR LRI=0:0
- SET LRI=$ORDER(^LRE("AD",LRA,LRI))
- if 'LRI!(LR("Q"))
- QUIT
- IF $DATA(^LRE(LRI,5,LRIDT,0))
- SET X=^(0)
- SET A=+X
- SET B=+$PIECE(X,"^",13)
- SET ^TMP($JOB,A,B,LRI)=$PIECE(X,"^",4)_"^"_$PIECE(X,"^",2)_"^"_$PIECE(X,"^",11)_"^"_$PIECE(X,"^",5)
- +1 QUIT
- T FOR B="A","H","T","D"
- if LR("Q")
- QUIT
- IF LR(A,"S",B)
- WRITE !?13,$PIECE($PIECE(LRT,B_":",2),";"),?24,":",$JUSTIFY(LR(A,"S",B),4)
- if $Y>(IOSL-6)
- DO H2
- +1 QUIT
- +2 ;
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- if LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,"DONOR SCHEDULING REPORT FROM ",LRSTR," TO ",LRLST
- +2 WRITE !,"ARRIVAL/APPT",?15,"UNIT ID",?28,"DON/DEF",?43,"DON. TYPE",?54,"PATIENT CREDIT",!,LR("%")
- QUIT
- H1 DO H
- if LR("Q")
- QUIT
- WRITE !!?2,"DONATION OR DEFERRAL DATE: ",LRW
- QUIT
- H2 DO H
- if LR("Q")
- QUIT
- WRITE !?2,"Total Count: "
- QUIT
- +1 ;
- END DO V^LRU
- QUIT