- APCHS3F ; IHS/CMI/LAB - PART 3A OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- MRL ; ******************** MOST RECENT LAB * 9000010.09 *******
- I '$D(^AUPNVBB("AA",APCHSPAT)) G MRLX
- W !?3,"See the Lab Package for More Complete Blood Bank Information than ",!,"contained below."
- X APCHSCKP Q:$D(APCHSQIT)
- X:'APCHSNPG APCHSBRK
- ; <SETUP>
- ; <PROCESS>
- D LBLD,LPRT
- D ANTIBOD
- ; <CLEANUP>
- MRLX K APCHSLT,APCHSLR,APCHSLTX,APCHSLRT,APCHSLL,APCHSLW,APCHSNMX,APCHSDFN,APCHSIVD,APCHSLTD,APCHSN,Y
- K ^TMP($J,"APCHS"),^TMP($J,"APCHS1")
- Q
- ; <BUILD>
- LBLD K ^TMP($J,"APCHS","LAB"),^TMP($J,"APCHS1")
- S APCHSLRT="" F APCHSQ=0:0 S APCHSLRT=$O(^AUPNVBB("AA",APCHSPAT,APCHSLRT)) Q:APCHSLRT="" D LDATE
- D REORDER
- Q
- REORDER ;reorder by accession, parent and child
- S X=0 F S X=$O(^TMP($J,"APCHS","LAB",X)) Q:X'=+X D
- .S D=0 F S D=$O(^TMP($J,"APCHS","LAB",X,D)) Q:D'=+D D
- ..S Y=$P(^TMP($J,"APCHS","LAB",X,D),U,3)
- ..;S %=$E($P(^AUPNVBB(Y,0),U,6),1,2) S:%="" %="ZZ"
- ..S %=X
- ..S %1=$S($P($G(^AUPNVBB(Y,12)),U,8)]"":$P(^AUPNVBB(Y,12),U,8),1:Y)
- ..S %2=$S($P($G(^AUPNVBB(Y,12)),U,8)="":0,1:Y)
- ..S ^TMP($J,"APCHS1",%,%1,%2,X)=^TMP($J,"APCHS","LAB",X,D)
- .Q
- K ^TMP($J,"APCHS")
- Q
- LDATE S APCHSIVD=$O(^AUPNVBB("AA",APCHSPAT,APCHSLRT,0))
- S APCHSDFN=0 F S APCHSDFN=$O(^AUPNVBB("AA",APCHSPAT,APCHSLRT,APCHSIVD,APCHSDFN)) Q:APCHSDFN'=+APCHSDFN D:APCHSIVD&(APCHSIVD'>APCHSDLM) LSET
- Q
- LSET ;
- S APCHSN=^AUPNVBB(APCHSDFN,0),APCHSLR=$P(APCHSN,U,4)
- I $P($G(^AUPNVBB(APCHSDFN,11)),U,9)="R",APCHSLR="",$$VALI^XBDIQ1(60,$P(APCHSN,U),999999901) Q ;do not display tests that are resulted, result is null and flag says don't display
- ;I APCHSLR="",$P($G(^TMP($J,"APCHS","LAB",APCHSLRT)),U,2)]"" Q
- ;S P=$P($G(^AUPNVBB(APCHSDFN,12)),U,8) I P="" S P=APCHSDFN
- ;S C=APCHSDFN I $P($G(^AUPNVBB(APCHSDFN,12)),U,8)="" S C=0
- S ^TMP($J,"APCHS","LAB",APCHSLRT,APCHSDFN)=(-APCHSIVD\1+9999999)_U_APCHSLR_U_APCHSDFN S APCHSLTX=$P(^LAB(60,APCHSLRT,0),U,1)
- Q
- ; <PRINT>
- LPRT ;
- W ?34,"COLL DATE",?45,"RESULTS",?60,"ANTIBODY",!
- S APCHSACC="" F S APCHSACC=$O(^TMP($J,"APCHS1",APCHSACC)) Q:APCHSACC=""!($D(APCHSQIT)) D
- .S APCHSPAR=0 F S APCHSPAR=$O(^TMP($J,"APCHS1",APCHSACC,APCHSPAR)) Q:APCHSPAR'=+APCHSPAR!($D(APCHSQIT)) D
- ..S APCHCHIL="" F S APCHCHIL=$O(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL)) Q:APCHCHIL="" D
- ...S APCHSLT=$O(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,0))
- ...S APCHSDFN=$P(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,3)
- ...S Y=$P(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,1),APCHSLR=$P(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,2) X APCHSCVD S APCHSLTD=Y
- ...D LPRT2
- K APCHCHIL,APCHSPAR,APCHSACC,APCHSLT
- Q
- LPRT2 ;
- S APCHSLTX=$S($P($G(^AUPNVBB(APCHSDFN,0)),U,7)]"":$P(^AUPNVBB(APCHSDFN,0),U,7),1:$P(^LAB(60,APCHSLT,0),U))
- X APCHSCKP Q:$D(APCHSQIT) I APCHSNPG W ?34,"COLL DATE",?45,"RESULTS",?60,"ANTIBODY",!
- W:APCHCHIL " " W:'APCHCHIL ! W APCHSLTX,$S(APCHCHIL:"",1:":"),?35,APCHSLTD,?45,APCHSLR
- W ?60,$$VAL^XBDIQ1(9000010.31,APCHSDFN,.05)
- ;W ?78," ",$P($G(^AUPNVBB(APCHSDFN,11)),U,9)
- W !
- Q
- ;
- ANTIBOD ; - antibody display
- ;gather up all v blood bank entries with an antibody and display
- Q:'$D(^AUPNVBB("AC",APCHSPAT))
- K ^TMP($J,"APCHS")
- S X=0 F S X=$O(^AUPNVBB("AC",APCHSPAT,X)) Q:X'=+X D
- .Q:'$D(^AUPNVBB(X,0))
- .S A=$P(^AUPNVBB(X,0),U,5) Q:A=""
- .S Y="",V=$P(^AUPNVBB(X,0),U,3) I V,$D(^AUPNVSIT(V,0)) S Y=$P($P(^AUPNVSIT(V,0),U),".")=$P
- .S D=$P($P($G(^AUPNVBB(X,12)),U),".")
- .S D=$S(D]"":D,1:Y),D=9999999-D
- .S ^TMP($J,"APCHS",A,D,X)=""
- .Q
- PRTANTI ;
- G:'$D(^TMP($J,"APCHS")) ANTIBODX
- X APCHSCKP G:$D(APCHSQIT) ANTIBODX
- W !!?2,"ANTIBODIES",!
- S APCHSA=0 F S APCHSA=$O(^TMP($J,"APCHS",APCHSA)) Q:APCHSA'=+APCHSA!($D(APCHSQIT)) D
- .S APCHSD=$O(^TMP($J,"APCHS",APCHSA,0))
- .X APCHSCKP Q:$D(APCHSQIT) I APCHSNPG W !!?2,"ANTIBODIES",!
- .S Y=9999999-APCHSD X APCHSCVD
- .W ?3,Y,?13,$P($G(^LAB(61.3,APCHSA,0)),U),!
- ANTIBODX ;
- K V,X,Y,D,APCHSX,APCHSD
- K ^TMP($J,"APCHS")
- Q
- ;
- ;
- APCHS3F ; IHS/CMI/LAB - PART 3A OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- MRL ; ******************** MOST RECENT LAB * 9000010.09 *******
- +1 IF '$DATA(^AUPNVBB("AA",APCHSPAT))
- GOTO MRLX
- +2 WRITE !?3,"See the Lab Package for More Complete Blood Bank Information than ",!,"contained below."
- +3 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- +4 IF 'APCHSNPG
- XECUTE APCHSBRK
- +5 ; <SETUP>
- +6 ; <PROCESS>
- +7 DO LBLD
- DO LPRT
- +8 DO ANTIBOD
- +9 ; <CLEANUP>
- MRLX KILL APCHSLT,APCHSLR,APCHSLTX,APCHSLRT,APCHSLL,APCHSLW,APCHSNMX,APCHSDFN,APCHSIVD,APCHSLTD,APCHSN,Y
- +1 KILL ^TMP($JOB,"APCHS"),^TMP($JOB,"APCHS1")
- +2 QUIT
- +3 ; <BUILD>
- LBLD KILL ^TMP($JOB,"APCHS","LAB"),^TMP($JOB,"APCHS1")
- +1 SET APCHSLRT=""
- FOR APCHSQ=0:0
- SET APCHSLRT=$ORDER(^AUPNVBB("AA",APCHSPAT,APCHSLRT))
- IF APCHSLRT=""
- QUIT
- DO LDATE
- +2 DO REORDER
- +3 QUIT
- REORDER ;reorder by accession, parent and child
- +1 SET X=0
- FOR
- SET X=$ORDER(^TMP($JOB,"APCHS","LAB",X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET D=0
- FOR
- SET D=$ORDER(^TMP($JOB,"APCHS","LAB",X,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +3 SET Y=$PIECE(^TMP($JOB,"APCHS","LAB",X,D),U,3)
- +4 ;S %=$E($P(^AUPNVBB(Y,0),U,6),1,2) S:%="" %="ZZ"
- +5 SET %=X
- +6 SET %1=$SELECT($PIECE($GET(^AUPNVBB(Y,12)),U,8)]"":$PIECE(^AUPNVBB(Y,12),U,8),1:Y)
- +7 SET %2=$SELECT($PIECE($GET(^AUPNVBB(Y,12)),U,8)="":0,1:Y)
- +8 SET ^TMP($JOB,"APCHS1",%,%1,%2,X)=^TMP($JOB,"APCHS","LAB",X,D)
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 KILL ^TMP($JOB,"APCHS")
- +11 QUIT
- LDATE SET APCHSIVD=$ORDER(^AUPNVBB("AA",APCHSPAT,APCHSLRT,0))
- +1 SET APCHSDFN=0
- FOR
- SET APCHSDFN=$ORDER(^AUPNVBB("AA",APCHSPAT,APCHSLRT,APCHSIVD,APCHSDFN))
- IF APCHSDFN'=+APCHSDFN
- QUIT
- IF APCHSIVD&(APCHSIVD'>APCHSDLM)
- DO LSET
- +2 QUIT
- LSET ;
- +1 SET APCHSN=^AUPNVBB(APCHSDFN,0)
- SET APCHSLR=$PIECE(APCHSN,U,4)
- +2 ;do not display tests that are resulted, result is null and flag says don't display
- IF $PIECE($GET(^AUPNVBB(APCHSDFN,11)),U,9)="R"
- IF APCHSLR=""
- IF $$VALI^XBDIQ1(60,$PIECE(APCHSN,U),999999901)
- QUIT
- +3 ;I APCHSLR="",$P($G(^TMP($J,"APCHS","LAB",APCHSLRT)),U,2)]"" Q
- +4 ;S P=$P($G(^AUPNVBB(APCHSDFN,12)),U,8) I P="" S P=APCHSDFN
- +5 ;S C=APCHSDFN I $P($G(^AUPNVBB(APCHSDFN,12)),U,8)="" S C=0
- +6 SET ^TMP($JOB,"APCHS","LAB",APCHSLRT,APCHSDFN)=(-APCHSIVD\1+9999999)_U_APCHSLR_U_APCHSDFN
- SET APCHSLTX=$PIECE(^LAB(60,APCHSLRT,0),U,1)
- +7 QUIT
- +8 ; <PRINT>
- LPRT ;
- +1 WRITE ?34,"COLL DATE",?45,"RESULTS",?60,"ANTIBODY",!
- +2 SET APCHSACC=""
- FOR
- SET APCHSACC=$ORDER(^TMP($JOB,"APCHS1",APCHSACC))
- IF APCHSACC=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +3 SET APCHSPAR=0
- FOR
- SET APCHSPAR=$ORDER(^TMP($JOB,"APCHS1",APCHSACC,APCHSPAR))
- IF APCHSPAR'=+APCHSPAR!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +4 SET APCHCHIL=""
- FOR
- SET APCHCHIL=$ORDER(^TMP($JOB,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL))
- IF APCHCHIL=""
- QUIT
- Begin DoDot:3
- +5 SET APCHSLT=$ORDER(^TMP($JOB,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,0))
- +6 SET APCHSDFN=$PIECE(^TMP($JOB,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,3)
- +7 SET Y=$PIECE(^TMP($JOB,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,1)
- SET APCHSLR=$PIECE(^TMP($JOB,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,2)
- XECUTE APCHSCVD
- SET APCHSLTD=Y
- +8 DO LPRT2
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 KILL APCHCHIL,APCHSPAR,APCHSACC,APCHSLT
- +10 QUIT
- LPRT2 ;
- +1 SET APCHSLTX=$SELECT($PIECE($GET(^AUPNVBB(APCHSDFN,0)),U,7)]"":$PIECE(^AUPNVBB(APCHSDFN,0),U,7),1:$PIECE(^LAB(60,APCHSLT,0),U))
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- IF APCHSNPG
- WRITE ?34,"COLL DATE",?45,"RESULTS",?60,"ANTIBODY",!
- +3 IF APCHCHIL
- WRITE " "
- IF 'APCHCHIL
- WRITE !
- WRITE APCHSLTX,$SELECT(APCHCHIL:"",1:":"),?35,APCHSLTD,?45,APCHSLR
- +4 WRITE ?60,$$VAL^XBDIQ1(9000010.31,APCHSDFN,.05)
- +5 ;W ?78," ",$P($G(^AUPNVBB(APCHSDFN,11)),U,9)
- +6 WRITE !
- +7 QUIT
- +8 ;
- ANTIBOD ; - antibody display
- +1 ;gather up all v blood bank entries with an antibody and display
- +2 IF '$DATA(^AUPNVBB("AC",APCHSPAT))
- QUIT
- +3 KILL ^TMP($JOB,"APCHS")
- +4 SET X=0
- FOR
- SET X=$ORDER(^AUPNVBB("AC",APCHSPAT,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +5 IF '$DATA(^AUPNVBB(X,0))
- QUIT
- +6 SET A=$PIECE(^AUPNVBB(X,0),U,5)
- IF A=""
- QUIT
- +7 SET Y=""
- SET V=$PIECE(^AUPNVBB(X,0),U,3)
- IF V
- IF $DATA(^AUPNVSIT(V,0))
- SET Y=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")=$PRINCIPAL
- +8 SET D=$PIECE($PIECE($GET(^AUPNVBB(X,12)),U),".")
- +9 SET D=$SELECT(D]"":D,1:Y)
- SET D=9999999-D
- +10 SET ^TMP($JOB,"APCHS",A,D,X)=""
- +11 QUIT
- End DoDot:1
- PRTANTI ;
- +1 IF '$DATA(^TMP($JOB,"APCHS"))
- GOTO ANTIBODX
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- GOTO ANTIBODX
- +3 WRITE !!?2,"ANTIBODIES",!
- +4 SET APCHSA=0
- FOR
- SET APCHSA=$ORDER(^TMP($JOB,"APCHS",APCHSA))
- IF APCHSA'=+APCHSA!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +5 SET APCHSD=$ORDER(^TMP($JOB,"APCHS",APCHSA,0))
- +6 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- IF APCHSNPG
- WRITE !!?2,"ANTIBODIES",!
- +7 SET Y=9999999-APCHSD
- XECUTE APCHSCVD
- +8 WRITE ?3,Y,?13,$PIECE($GET(^LAB(61.3,APCHSA,0)),U),!
- End DoDot:1
- ANTIBODX ;
- +1 KILL V,X,Y,D,APCHSX,APCHSD
- +2 KILL ^TMP($JOB,"APCHS")
- +3 QUIT
- +4 ;
- +5 ;
