BWUPTNI ;IHS/ANMC/MWR - UPLOAD: TABLE FROM CORNING;15-Feb-2003 22:13;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CONVERT AND STORE NICHOL'S ABBREVIATIONS TABLE.
;; CALLED BY BWUPLD.
;
;
;---> CONVERSION AND TRANSFER OF RESULTS TABLE FOR * CORNING LAB *.
;---> THIS ROUTINE IS CALLED BY ^BWUPLD. "CVT" CONVERTS CORNING LAB
;---> FIXED LENGTH ASCII TEXT LAB RESULTS ABBREVIATIONS AND TEXT
;---> INTO "^" DELIMITED VARIABLE LENGTH RECORDS.
;---> EACH CORNING RECORD CONTAINS AN ABBREVIATION, TEXT,
;---> AND A SEQUENCE NUMBER. MULTIPLE RECORDS RECORDS (OR LINES)
;---> FORMING ONE RESULT TEXT AND REPRESENTED BY THE SAME ABBREVIATION
;---> ARE GROUPED BY VIRTUE OF HAVING THE SAME ABBREVIATION, AND ARE
;---> ORDERED BY THEIR SEQUENCE NUMBERS.
;--->
;---> "TRANS" FORMATS AND TRANSFERS ENTRIES IN "BW UPLD TABLE TEMP
;---> (CORNING)" FILE INTO THE "BW UPLD TABLE PERM (ALL)" FILE.
;---> AS THE ENTRIES ARE TRANSFERED, RECORDS OF TEXT BELONGING TO
;---> THE SAME ABBREVIATION ARE GROUPED AND STORED IN A WP FIELD
;---> UNDER A SINGLE ENTRY FOR THAT ABBREVIATION (.01 FIELD).
;
CVT(LINE,PIECE) ;EP
;---> COVERT FIXED LENGTH INTO "^" DELIMITED VARIABLE LENGTH.
;---> PIECE=0 SAYS DO NOT PIECE BWLINE WHEN RETURNED TO BWUPLD.
I '$D(LINE) S LINE="" Q
N Y,Z
;---> TRANSLATE ALL "^" INTO "`".
S Y=$TR(LINE,"^","`")
;---> EXTRACT THE ABBREVIATION.
S Z=$$TRIM($E(Y,1,6))
;---> EXTRACT THE SEQUENCE NUMBER.
S Z=Z_U_$$TRIM2($E(Y,9,12))
;---> EXTRACT AND CONCATENATE THE TEXT.
S LINE=Z_U_$$TRIM($E(Y,13,66)),PIECE=0
S:$P(LINE,U,3)=""&($P(LINE,U)'="YYES") LINE=""
Q
;
TRIM(X) ;EP
;---> TRIM OFF ANY TRAILING SPACES.
Q:'$D(X) ""
N L S L=$L(X)
F Q:$E(X,L)'=" " S L=L-1
Q $E(X,1,L)
;
TRIM2(X) ;EP
;---> TRIM OFF ANY LEADING SPACES.
Q:'$D(X) ""
N I,L S L=$L(X)
F I=1:1 Q:$E(X,I)'=" "
Q $E(X,I,L)
;
;
TRANS ;EP
;---> * FOR CORNING LAB *
;---> GROUP AND COPY ENTRIES FROM "BW UPLD TABLE TEMP (CORNING)"
;---> FILE INTO THE "BW UPLD TABLE FINAL (CORNING)" FILE.
D SETVARS^BWUTL5
;---> ZERO OUT PREVIOUS DATA IN TABLE FINAL FILE.
D ZGBL^BWUTL8("^BWTFNI")
W !?5,"Transferring to ""BW UPLD TABLE FINAL (CORNING)"" FILE..." H 1
S BWABBV=0
F S BWABBV=$O(^BWTNI("B",BWABBV)) Q:BWABBV="" D
.;---> DIC LOOKUP/ADD OF NEW ABBREVIATION IN FINAL FILE.
.D DIC^BWFMAN(9002086.85,"QML",.Y,"","","",BWABBV)
.I Y<0 W ?10,"FAILED TO ADD/EDIT ",BWABBV,"!" Q
.;---> NOW COPY TEMP TABLE ENTRIES INTO NEW FINAL TABLE ENTRY.
.S (M,N)=0,Y=+Y
.F S N=$O(^BWTNI("B",BWABBV,N)) Q:'N D
..S M=M+1,^BWTFNI(Y,1,M,0)=$P(^BWTNI(N,0),U,3)
.S ^BWTFNI(Y,1,0)="^^"_M_U_M_U_DT
Q
BWUPTNI ;IHS/ANMC/MWR - UPLOAD: TABLE 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 ;; CONVERT AND STORE NICHOL'S ABBREVIATIONS TABLE.
+4 ;; CALLED BY BWUPLD.
+5 ;
+6 ;
+7 ;---> CONVERSION AND TRANSFER OF RESULTS TABLE FOR * CORNING LAB *.
+8 ;---> THIS ROUTINE IS CALLED BY ^BWUPLD. "CVT" CONVERTS CORNING LAB
+9 ;---> FIXED LENGTH ASCII TEXT LAB RESULTS ABBREVIATIONS AND TEXT
+10 ;---> INTO "^" DELIMITED VARIABLE LENGTH RECORDS.
+11 ;---> EACH CORNING RECORD CONTAINS AN ABBREVIATION, TEXT,
+12 ;---> AND A SEQUENCE NUMBER. MULTIPLE RECORDS RECORDS (OR LINES)
+13 ;---> FORMING ONE RESULT TEXT AND REPRESENTED BY THE SAME ABBREVIATION
+14 ;---> ARE GROUPED BY VIRTUE OF HAVING THE SAME ABBREVIATION, AND ARE
+15 ;---> ORDERED BY THEIR SEQUENCE NUMBERS.
+16 ;--->
+17 ;---> "TRANS" FORMATS AND TRANSFERS ENTRIES IN "BW UPLD TABLE TEMP
+18 ;---> (CORNING)" FILE INTO THE "BW UPLD TABLE PERM (ALL)" FILE.
+19 ;---> AS THE ENTRIES ARE TRANSFERED, RECORDS OF TEXT BELONGING TO
+20 ;---> THE SAME ABBREVIATION ARE GROUPED AND STORED IN A WP FIELD
+21 ;---> UNDER A SINGLE ENTRY FOR THAT ABBREVIATION (.01 FIELD).
+22 ;
CVT(LINE,PIECE) ;EP
+1 ;---> COVERT FIXED LENGTH INTO "^" DELIMITED VARIABLE LENGTH.
+2 ;---> PIECE=0 SAYS DO NOT PIECE BWLINE WHEN RETURNED TO BWUPLD.
+3 IF '$DATA(LINE)
SET LINE=""
QUIT
+4 NEW Y,Z
+5 ;---> TRANSLATE ALL "^" INTO "`".
+6 SET Y=$TRANSLATE(LINE,"^","`")
+7 ;---> EXTRACT THE ABBREVIATION.
+8 SET Z=$$TRIM($EXTRACT(Y,1,6))
+9 ;---> EXTRACT THE SEQUENCE NUMBER.
+10 SET Z=Z_U_$$TRIM2($EXTRACT(Y,9,12))
+11 ;---> EXTRACT AND CONCATENATE THE TEXT.
+12 SET LINE=Z_U_$$TRIM($EXTRACT(Y,13,66))
SET PIECE=0
+13 IF $PIECE(LINE,U,3)=""&($PIECE(LINE,U)'="YYES")
SET LINE=""
+14 QUIT
+15 ;
TRIM(X) ;EP
+1 ;---> TRIM OFF ANY TRAILING SPACES.
+2 IF '$DATA(X)
QUIT ""
+3 NEW L
SET L=$LENGTH(X)
+4 FOR
IF $EXTRACT(X,L)'=" "
QUIT
SET L=L-1
+5 QUIT $EXTRACT(X,1,L)
+6 ;
TRIM2(X) ;EP
+1 ;---> TRIM OFF ANY LEADING SPACES.
+2 IF '$DATA(X)
QUIT ""
+3 NEW I,L
SET L=$LENGTH(X)
+4 FOR I=1:1
IF $EXTRACT(X,I)'=" "
QUIT
+5 QUIT $EXTRACT(X,I,L)
+6 ;
+7 ;
TRANS ;EP
+1 ;---> * FOR CORNING LAB *
+2 ;---> GROUP AND COPY ENTRIES FROM "BW UPLD TABLE TEMP (CORNING)"
+3 ;---> FILE INTO THE "BW UPLD TABLE FINAL (CORNING)" FILE.
+4 DO SETVARS^BWUTL5
+5 ;---> ZERO OUT PREVIOUS DATA IN TABLE FINAL FILE.
+6 DO ZGBL^BWUTL8("^BWTFNI")
+7 WRITE !?5,"Transferring to ""BW UPLD TABLE FINAL (CORNING)"" FILE..."
HANG 1
+8 SET BWABBV=0
+9 FOR
SET BWABBV=$ORDER(^BWTNI("B",BWABBV))
IF BWABBV=""
QUIT
Begin DoDot:1
+10 ;---> DIC LOOKUP/ADD OF NEW ABBREVIATION IN FINAL FILE.
+11 DO DIC^BWFMAN(9002086.85,"QML",.Y,"","","",BWABBV)
+12 IF Y<0
WRITE ?10,"FAILED TO ADD/EDIT ",BWABBV,"!"
QUIT
+13 ;---> NOW COPY TEMP TABLE ENTRIES INTO NEW FINAL TABLE ENTRY.
+14 SET (M,N)=0
SET Y=+Y
+15 FOR
SET N=$ORDER(^BWTNI("B",BWABBV,N))
IF 'N
QUIT
Begin DoDot:2
+16 SET M=M+1
SET ^BWTFNI(Y,1,M,0)=$PIECE(^BWTNI(N,0),U,3)
End DoDot:2
+17 SET ^BWTFNI(Y,1,0)="^^"_M_U_M_U_DT
End DoDot:1
+18 QUIT
