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 ;
