- 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
