BWUPRNI1.m

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