BWUPRNI1 ;IHS/ANMC/MWR - UPLOAD: RESULTS FROM CORNING;15-Feb-2003 22:13;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; FORMATS TEXT OF RESULTS REPORT INTO LOCAL ARRAY.
;; CALLED BY BWUPRNI.
;
;
;---> CALLED BY BWUPRNI. PUTS ENTIRE TEXT OF RESULTS REPORT INTO
;---> BW1(N) LOCAL ARRAY, FORMATTED.
;---> REQUIRED VARIABLES: BWY=IEN IN NICHOL'S TEMP FILE.
;
FORMAT(BWY) ;EP
Q:'BWY
N I,X,Y,Z K BW1
;---> SET DATA NODES (0,1,2) FOR THIS LAB REPORT EQUAL TO X,Y,Z.
S X=^BWRNI(BWY,0),Y=^BWRNI(BWY,1),Z=^BWRNI(BWY,2)
;
S BW1(1)="CORNING Clinical Laboratories SSN: "_$P(X,U,3)
S BW1(2)="16 Concord Street"
S BW1(3)="El Paso, Texas 79906 Patient: "_$P(X,U,2)
S BW1(4)="915/775-2622 or 800/999-7284 Chart#: "_$P(X,U,7)
S BW1(5)="Account No. "_$P(X,U,9)
S BW1(5)=BW1(5)_$E(" ",1,(22-$L($P(X,U,9))))
S BW1(5)=BW1(5)_"Date Collected: "_$P(X,U,11)
S BW1(6)=" "
S BW1(7)="Accession#: "_$P(X,U)
S BW1(7)=BW1(7)_$E(" ",1,(27-$L($P(X,U))))
S BW1(7)=BW1(7)_"Req/ID No: "_$P(X,U,4)
S BW1(8)="Physician : "_$P(X,U,8)
S BW1(8)=BW1(8)_$E(" ",1,(28-$L($P(X,U,8))))
S BW1(8)=BW1(8)_"Location: "_$P(X,U,12)
S BW1(9)="------------------------------------------------------------"
S BW1(10)="TEST NAME NOT REPORTED BY LAB."
S:$P(X,U,10)]"" BW1(10)=$P(X,U,10)
S I=12
S BW1(I)="Source",I=I+1
S BWABBVS=$P(Y,U) D GETEXT
S BW1(I)="Specimen Adequacy",I=I+1
S BWABBVS=$P(Y,U,2) D GETEXT
S BW1(I)="Gen Categorization",I=I+1
S BWABBVS=$P(Y,U,3) D GETEXT
S BW1(I)="Descript Diagnosis",I=I+1
I $P(Y,U,4)]"" S BWABBVS=$P(Y,U,4) D GETEXT
I $P(Y,U,5)]""!($P(Y,U,6)]"") D
.S BW1(I)=" Epithelial Abnormalities",I=I+1
.I $P(Y,U,5)]"" D
..S BW1(I)=" Squamous Cells",I=I+1
..S BWABBVS=$P(Y,U,5) D GETEXT
.I $P(Y,U,6)]"" D
..S BW1(I)=" Glandular Cells",I=I+1
..S BWABBVS=$P(Y,U,6) D GETEXT
I $P(Z,U)]"" D
.S BW1(I)=" React/Reparative",I=I+1
.S BWABBVS=$P(Z,U) D GETEXT
I $P(Z,U,2)]"" D
.S BW1(I)=" Infection",I=I+1
.S BWABBVS=$P(Z,U,2) D GETEXT
I $P(Z,U,3)]"" D
.S BW1(I)=" Infection Notation",I=I+1
.S BWABBVS=$P(Z,U,3) D GETEXT
I $P(Z,U,4)]"" D
.S BW1(I)="Hormonal Evaluation",I=I+1
.S BWABBVS=$P(Z,U,4) D GETEXT
I $P(Z,U,5)]"" D
.S BW1(I)="Hormonal Eval Notation",I=I+1
.S BWABBVS=$P(Z,U,5) D GETEXT
I $P(Z,U,6)]"" D
.S BW1(I)="Comment",I=I+1
.S BWABBVS=$P(Z,U,6) D GETEXT
S BW1(I)=" ",I=I+1
I $P(Z,U,7)]"" S BW1(I)="Reviewer: "_$P(Z,U,7),I=I+1
Q
;
GETEXT ;EP
N J,N,Y
I BWABBVS="" S BW1(I)=BWTAB_"Not reported by lab." Q
F J=2:1:10 S BWABBV=$P(BWABBVS,"\",J) D
.Q:BWABBV=""
.S Y=$O(^BWTFNI("B",BWABBV,0))
.I Y="" D Q
..S BW1(I)=BWTAB_"The abbreviation "_BWABBV_" is not in the ",I=I+1
..S BW1(I)=BWTAB_"""BW LAB TABLE"" file. Contact your site manager."
..S I=I+1
.S N=0
.F S N=$O(^BWTFNI(Y,1,N)) Q:'N D
..S BW1(I)=BWTAB_^BWTFNI(Y,1,N,0),I=I+1
Q
BWUPRNI1 ;IHS/ANMC/MWR - UPLOAD: RESULTS FROM CORNING;15-Feb-2003 22:13;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; FORMATS TEXT OF RESULTS REPORT INTO LOCAL ARRAY.
+4 ;; CALLED BY BWUPRNI.
+5 ;
+6 ;
+7 ;---> CALLED BY BWUPRNI. PUTS ENTIRE TEXT OF RESULTS REPORT INTO
+8 ;---> BW1(N) LOCAL ARRAY, FORMATTED.
+9 ;---> REQUIRED VARIABLES: BWY=IEN IN NICHOL'S TEMP FILE.
+10 ;
FORMAT(BWY) ;EP
+1 IF 'BWY
QUIT
+2 NEW I,X,Y,Z
KILL BW1
+3 ;---> SET DATA NODES (0,1,2) FOR THIS LAB REPORT EQUAL TO X,Y,Z.
+4 SET X=^BWRNI(BWY,0)
SET Y=^BWRNI(BWY,1)
SET Z=^BWRNI(BWY,2)
+5 ;
+6 SET BW1(1)="CORNING Clinical Laboratories SSN: "_$PIECE(X,U,3)
+7 SET BW1(2)="16 Concord Street"
+8 SET BW1(3)="El Paso, Texas 79906 Patient: "_$PIECE(X,U,2)
+9 SET BW1(4)="915/775-2622 or 800/999-7284 Chart#: "_$PIECE(X,U,7)
+10 SET BW1(5)="Account No. "_$PIECE(X,U,9)
+11 SET BW1(5)=BW1(5)_$EXTRACT(" ",1,(22-$LENGTH($PIECE(X,U,9))))
+12 SET BW1(5)=BW1(5)_"Date Collected: "_$PIECE(X,U,11)
+13 SET BW1(6)=" "
+14 SET BW1(7)="Accession#: "_$PIECE(X,U)
+15 SET BW1(7)=BW1(7)_$EXTRACT(" ",1,(27-$LENGTH($PIECE(X,U))))
+16 SET BW1(7)=BW1(7)_"Req/ID No: "_$PIECE(X,U,4)
+17 SET BW1(8)="Physician : "_$PIECE(X,U,8)
+18 SET BW1(8)=BW1(8)_$EXTRACT(" ",1,(28-$LENGTH($PIECE(X,U,8))))
+19 SET BW1(8)=BW1(8)_"Location: "_$PIECE(X,U,12)
+20 SET BW1(9)="------------------------------------------------------------"
+21 SET BW1(10)="TEST NAME NOT REPORTED BY LAB."
+22 IF $PIECE(X,U,10)]""
SET BW1(10)=$PIECE(X,U,10)
+23 SET I=12
+24 SET BW1(I)="Source"
SET I=I+1
+25 SET BWABBVS=$PIECE(Y,U)
DO GETEXT
+26 SET BW1(I)="Specimen Adequacy"
SET I=I+1
+27 SET BWABBVS=$PIECE(Y,U,2)
DO GETEXT
+28 SET BW1(I)="Gen Categorization"
SET I=I+1
+29 SET BWABBVS=$PIECE(Y,U,3)
DO GETEXT
+30 SET BW1(I)="Descript Diagnosis"
SET I=I+1
+31 IF $PIECE(Y,U,4)]""
SET BWABBVS=$PIECE(Y,U,4)
DO GETEXT
+32 IF $PIECE(Y,U,5)]""!($PIECE(Y,U,6)]"")
Begin DoDot:1
+33 SET BW1(I)=" Epithelial Abnormalities"
SET I=I+1
+34 IF $PIECE(Y,U,5)]""
Begin DoDot:2
+35 SET BW1(I)=" Squamous Cells"
SET I=I+1
+36 SET BWABBVS=$PIECE(Y,U,5)
DO GETEXT
End DoDot:2
+37 IF $PIECE(Y,U,6)]""
Begin DoDot:2
+38 SET BW1(I)=" Glandular Cells"
SET I=I+1
+39 SET BWABBVS=$PIECE(Y,U,6)
DO GETEXT
End DoDot:2
End DoDot:1
+40 IF $PIECE(Z,U)]""
Begin DoDot:1
+41 SET BW1(I)=" React/Reparative"
SET I=I+1
+42 SET BWABBVS=$PIECE(Z,U)
DO GETEXT
End DoDot:1
+43 IF $PIECE(Z,U,2)]""
Begin DoDot:1
+44 SET BW1(I)=" Infection"
SET I=I+1
+45 SET BWABBVS=$PIECE(Z,U,2)
DO GETEXT
End DoDot:1
+46 IF $PIECE(Z,U,3)]""
Begin DoDot:1
+47 SET BW1(I)=" Infection Notation"
SET I=I+1
+48 SET BWABBVS=$PIECE(Z,U,3)
DO GETEXT
End DoDot:1
+49 IF $PIECE(Z,U,4)]""
Begin DoDot:1
+50 SET BW1(I)="Hormonal Evaluation"
SET I=I+1
+51 SET BWABBVS=$PIECE(Z,U,4)
DO GETEXT
End DoDot:1
+52 IF $PIECE(Z,U,5)]""
Begin DoDot:1
+53 SET BW1(I)="Hormonal Eval Notation"
SET I=I+1
+54 SET BWABBVS=$PIECE(Z,U,5)
DO GETEXT
End DoDot:1
+55 IF $PIECE(Z,U,6)]""
Begin DoDot:1
+56 SET BW1(I)="Comment"
SET I=I+1
+57 SET BWABBVS=$PIECE(Z,U,6)
DO GETEXT
End DoDot:1
+58 SET BW1(I)=" "
SET I=I+1
+59 IF $PIECE(Z,U,7)]""
SET BW1(I)="Reviewer: "_$PIECE(Z,U,7)
SET I=I+1
+60 QUIT
+61 ;
GETEXT ;EP
+1 NEW J,N,Y
+2 IF BWABBVS=""
SET BW1(I)=BWTAB_"Not reported by lab."
QUIT
+3 FOR J=2:1:10
SET BWABBV=$PIECE(BWABBVS,"\",J)
Begin DoDot:1
+4 IF BWABBV=""
QUIT
+5 SET Y=$ORDER(^BWTFNI("B",BWABBV,0))
+6 IF Y=""
Begin DoDot:2
+7 SET BW1(I)=BWTAB_"The abbreviation "_BWABBV_" is not in the "
SET I=I+1
+8 SET BW1(I)=BWTAB_"""BW LAB TABLE"" file. Contact your site manager."
+9 SET I=I+1
End DoDot:2
QUIT
+10 SET N=0
+11 FOR
SET N=$ORDER(^BWTFNI(Y,1,N))
IF 'N
QUIT
Begin DoDot:2
+12 SET BW1(I)=BWTAB_^BWTFNI(Y,1,N,0)
SET I=I+1
End DoDot:2
End DoDot:1
+13 QUIT
