- BWUPRNI ;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 *
- ;; CONVERTS NICHOL'S LAB RESULTS FROM FIXED TO VARIABLE, THEN FORMATS
- ;; REPORTS AND PLACES THEM IN BW PROCEDURE FILE (WP) WITH PATIENTS.
- ;
- ;---> * FOR CORNING LAB *
- ;
- ;---> CONVERSION AND TRANSFER OF RESULTS FOR * CORNING LAB *.
- ;---> THIS ROUTINE IS CALLED BY ^BWUPLD. "CVT" CONVERTS CORNING LAB
- ;---> FIXED LENGTH ASCII TEXT LAB RESULTS ABBREVIATIONS INTO VARIABLE
- ;---> RECORDS AND ADDS THEM TO THE "BW UPLD RESULTS TEMP (CORNING)"
- ;---> FILE.
- ;--->
- ;---> "TRANS" FORMATS AND TRANSFERS ENTRIES FROM THE "BW UPLD RESULTS
- ;---> TEMP (CORNING)" FILE INTO THE WP FIELD OF THE "BW PROCEDURE"
- ;---> FILE. MATCHING IS DONE ON THE BASIS OF THE ACCESSION#, THE "B"
- ;---> CROSSREFERENCE AND THEN CHART# FOR IHS, SSN# FOR NON-IHS.
- ;
- CVT(LINE,PIECE) ;EP
- ;---> COVERT FIXED LENGTH INTO "^" DELIMITED VARIABLE LENGTH.
- ;---> PIECE=1 SAYS PIECE BWLINE WHEN RETURNED TO BWUPLD.
- N Y,Z
- ;---> TRANSLATE ALL "^" INTO "`".
- S Y=$TR(LINE,"^","`")
- ;---> EXTRACT THE ACCESSION#, TRIM OFF ANY TRAILING SPACES.
- S Z=$$TRIM($E(Y,106,117))
- ;---> IF ACCESSION#="", SET ACC#=NICHOL'S REQUISITION#.
- S:Z']"" Z=$$TRIM($E(Y,47,62))
- ;---> EXTRACT THE PATIENT NAME, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,9,32))
- ;---> EXTRACT THE PATIENT SSN/ACCT#, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,33,46))
- ;---> EXTRACT THE REQUISITION#, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,47,62))
- ;---> EXTRACT THE DATE OF BIRTH.
- S Z=Z_U_$$TRIM($E(Y,63,72))
- ;---> EXTRACT THE AGE.
- S Z=Z_U_$$TRIM($E(Y,73,76))
- ;---> EXTRACT THE HOSPITAL ID#/CHART#, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,77,88))
- ;---> EXTRACT THE REFERRING PHYSICIAN, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,89,105))
- ;---> EXTRACT THE ACCOUNT#, TRIM TRAILING AND LEADING SPACES.
- S Z=Z_U_$$TRIM2($$TRIM($E(Y,1,8)))
- ;---> EXTRACT THE TEST NAME, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,118,139))
- ;---> EXTRACT THE COLLECTION DATE.
- S Z=Z_U_$$TRIM($E(Y,140,147))
- ;---> EXTRACT THE LOCATION.
- S Z=Z_U_$$TRIM($E(Y,148,153))
- ;---> EXTRACT THE SPECIMEN SOURCE, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,154,178))
- ;---> EXTRACT THE SPECIMEN ADEQUACY, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,179,203))
- ;---> EXTRACT THE GENERAL CATEGORIZATION, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,204,228))
- ;---> EXTRACT THE DESCRIPTIVE DIAGNOSIS, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,229,253))
- ;---> EXTRACT THE SQUAMOUS CELLS, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,254,278))
- ;---> EXTRACT THE GLANDULAR CELLS, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,279,303))
- ;---> EXTRACT THE REACTIVE/REPAIRATIVE, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,304,328))
- ;---> EXTRACT THE INFECTION, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,329,353))
- ;---> EXTRACT THE INFECTION NOTATION, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,354,378))
- ;---> EXTRACT THE HORMONAL EVALUATION, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,379,403))
- ;---> EXTRACT THE HORMONAL EVALUATION NOTATION, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,404,428))
- ;---> EXTRACT THE COMMENT, TRIM TRAILING SPACES.
- S Z=Z_U_$$TRIM($E(Y,429,453))
- ;---> EXTRACT THE REVIEWER, TRIM TRAILING SPACES.
- S LINE=Z_U_$$TRIM($E(Y,454,478)),PIECE=1
- 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 *
- ;---> "TRANS" FORMATS AND TRANSFERS ENTRIES FROM THE "BW UPLD RESULTS
- ;---> TEMP (CORNING)" FILE INTO THE WP FIELD OF THE "BW PROCEDURE"
- ;---> FILE. MATCHING IS DONE ON THE BASIS OF THE ACCESSION#, THE "B"
- ;---> CROSSREFERENCE.
- ;---> BWY WILL EQUAL THE IEN OF THE PROCEDURE, FILE 9002086.1.
- ;---> BWYY WILL EQUAL THE IEN OF THE LAB RESULT, FILE 9002086.82.
- N BWAGENCY,BWDFN,BWHRCN,BWSSN,BWY,BWYY
- S (BWMATCH,BWNOMAT)=0,BWTAB=" "
- W !?5,"Transferring to ""BW PROCEDURE"" FILE..." H 1
- S BWYY=0
- F S BWYY=$O(^BWRNI(BWYY)) Q:'BWYY D
- .;---> GET ACCESSION#, CHART#, AND SSN# FROM LAB RESULT.
- .S BWACC=$P(^BWRNI(BWYY,0),U),BWHRCN=$P(^(0),U,7),BWSSN=$P(^(0),U,3)
- .;
- .;---> GET IEN OF THE PROCEDURE, FILE 9002086.1, FOR THIS ACCESSION#.
- .S BWY=$O(^BWPCD("B",BWACC,0))
- .;
- .;---> XREF FAILED TO PRODUCE IEN IN PROCEDURE FILE (^BWPCD).
- .I BWY="" D NOMATCH^BWUPTRAN(BWYY,1) Q
- .I '$D(^BWPCD(BWY,0)) D NOMATCH^BWUPTRAN(BWYY,1) Q
- .;
- .;---> GET DFN AND AGENCY (IHS, STATE, OR VA).
- .S BWDFN=$P(^BWPCD(BWY,0),U,2)
- .S BWAGENCY=$$AGENCY^BWUTL5(DUZ(2))
- .;
- .;---> IF AGENCY IS IHS AND THE CHART# FOR THIS RESULT DOES NOT
- .;---> MATCH CHART# FOR THIS PATIENT, STORE RESULT AS UNMATCHED.
- .I BWAGENCY="i",$$HRCN1^BWUTL1(BWDFN,DUZ(2))'=+BWHRCN D Q
- ..D NOMATCH^BWUPTRAN(BWYY,3)
- .;
- .;---> FOR NON-IHS AGENCY, IF SSN# FOR THIS RESULT DOES NOT
- .;---> MATCH SSN# FOR THIS PATIENT, STORE RESULT AS UNMATCHED.
- .I BWAGENCY'="i",$$SSN^BWUTL1(BWDFN)'=+BWSSN D Q
- ..D NOMATCH^BWUPTRAN(BWYY,6)
- .;
- .;---> TEXT ALREADY STORED FOR THIS IEN IN PROCEDURE FILE (^BWPCD).
- .I $O(^BWPCD(BWY,1,0)) D NOMATCH^BWUPTRAN(BWYY,2) Q
- .;
- .;---> TRANSFER THIS LAB RESULT INTO IT'S PROCEDURE.
- .D TRANSFER^BWUPTRAN(BWYY,BWY)
- .;
- W !?5,"Number of results successfully matched: ",BWMATCH
- W !?5,"Number of results NOT matched.........: ",BWNOMAT,!
- Q
- BWUPRNI ;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 ;; CONVERTS NICHOL'S LAB RESULTS FROM FIXED TO VARIABLE, THEN FORMATS
- +4 ;; REPORTS AND PLACES THEM IN BW PROCEDURE FILE (WP) WITH PATIENTS.
- +5 ;
- +6 ;---> * FOR CORNING LAB *
- +7 ;
- +8 ;---> CONVERSION AND TRANSFER OF RESULTS FOR * CORNING LAB *.
- +9 ;---> THIS ROUTINE IS CALLED BY ^BWUPLD. "CVT" CONVERTS CORNING LAB
- +10 ;---> FIXED LENGTH ASCII TEXT LAB RESULTS ABBREVIATIONS INTO VARIABLE
- +11 ;---> RECORDS AND ADDS THEM TO THE "BW UPLD RESULTS TEMP (CORNING)"
- +12 ;---> FILE.
- +13 ;--->
- +14 ;---> "TRANS" FORMATS AND TRANSFERS ENTRIES FROM THE "BW UPLD RESULTS
- +15 ;---> TEMP (CORNING)" FILE INTO THE WP FIELD OF THE "BW PROCEDURE"
- +16 ;---> FILE. MATCHING IS DONE ON THE BASIS OF THE ACCESSION#, THE "B"
- +17 ;---> CROSSREFERENCE AND THEN CHART# FOR IHS, SSN# FOR NON-IHS.
- +18 ;
- CVT(LINE,PIECE) ;EP
- +1 ;---> COVERT FIXED LENGTH INTO "^" DELIMITED VARIABLE LENGTH.
- +2 ;---> PIECE=1 SAYS PIECE BWLINE WHEN RETURNED TO BWUPLD.
- +3 NEW Y,Z
- +4 ;---> TRANSLATE ALL "^" INTO "`".
- +5 SET Y=$TRANSLATE(LINE,"^","`")
- +6 ;---> EXTRACT THE ACCESSION#, TRIM OFF ANY TRAILING SPACES.
- +7 SET Z=$$TRIM($EXTRACT(Y,106,117))
- +8 ;---> IF ACCESSION#="", SET ACC#=NICHOL'S REQUISITION#.
- +9 IF Z']""
- SET Z=$$TRIM($EXTRACT(Y,47,62))
- +10 ;---> EXTRACT THE PATIENT NAME, TRIM TRAILING SPACES.
- +11 SET Z=Z_U_$$TRIM($EXTRACT(Y,9,32))
- +12 ;---> EXTRACT THE PATIENT SSN/ACCT#, TRIM TRAILING SPACES.
- +13 SET Z=Z_U_$$TRIM($EXTRACT(Y,33,46))
- +14 ;---> EXTRACT THE REQUISITION#, TRIM TRAILING SPACES.
- +15 SET Z=Z_U_$$TRIM($EXTRACT(Y,47,62))
- +16 ;---> EXTRACT THE DATE OF BIRTH.
- +17 SET Z=Z_U_$$TRIM($EXTRACT(Y,63,72))
- +18 ;---> EXTRACT THE AGE.
- +19 SET Z=Z_U_$$TRIM($EXTRACT(Y,73,76))
- +20 ;---> EXTRACT THE HOSPITAL ID#/CHART#, TRIM TRAILING SPACES.
- +21 SET Z=Z_U_$$TRIM($EXTRACT(Y,77,88))
- +22 ;---> EXTRACT THE REFERRING PHYSICIAN, TRIM TRAILING SPACES.
- +23 SET Z=Z_U_$$TRIM($EXTRACT(Y,89,105))
- +24 ;---> EXTRACT THE ACCOUNT#, TRIM TRAILING AND LEADING SPACES.
- +25 SET Z=Z_U_$$TRIM2($$TRIM($EXTRACT(Y,1,8)))
- +26 ;---> EXTRACT THE TEST NAME, TRIM TRAILING SPACES.
- +27 SET Z=Z_U_$$TRIM($EXTRACT(Y,118,139))
- +28 ;---> EXTRACT THE COLLECTION DATE.
- +29 SET Z=Z_U_$$TRIM($EXTRACT(Y,140,147))
- +30 ;---> EXTRACT THE LOCATION.
- +31 SET Z=Z_U_$$TRIM($EXTRACT(Y,148,153))
- +32 ;---> EXTRACT THE SPECIMEN SOURCE, TRIM TRAILING SPACES.
- +33 SET Z=Z_U_$$TRIM($EXTRACT(Y,154,178))
- +34 ;---> EXTRACT THE SPECIMEN ADEQUACY, TRIM TRAILING SPACES.
- +35 SET Z=Z_U_$$TRIM($EXTRACT(Y,179,203))
- +36 ;---> EXTRACT THE GENERAL CATEGORIZATION, TRIM TRAILING SPACES.
- +37 SET Z=Z_U_$$TRIM($EXTRACT(Y,204,228))
- +38 ;---> EXTRACT THE DESCRIPTIVE DIAGNOSIS, TRIM TRAILING SPACES.
- +39 SET Z=Z_U_$$TRIM($EXTRACT(Y,229,253))
- +40 ;---> EXTRACT THE SQUAMOUS CELLS, TRIM TRAILING SPACES.
- +41 SET Z=Z_U_$$TRIM($EXTRACT(Y,254,278))
- +42 ;---> EXTRACT THE GLANDULAR CELLS, TRIM TRAILING SPACES.
- +43 SET Z=Z_U_$$TRIM($EXTRACT(Y,279,303))
- +44 ;---> EXTRACT THE REACTIVE/REPAIRATIVE, TRIM TRAILING SPACES.
- +45 SET Z=Z_U_$$TRIM($EXTRACT(Y,304,328))
- +46 ;---> EXTRACT THE INFECTION, TRIM TRAILING SPACES.
- +47 SET Z=Z_U_$$TRIM($EXTRACT(Y,329,353))
- +48 ;---> EXTRACT THE INFECTION NOTATION, TRIM TRAILING SPACES.
- +49 SET Z=Z_U_$$TRIM($EXTRACT(Y,354,378))
- +50 ;---> EXTRACT THE HORMONAL EVALUATION, TRIM TRAILING SPACES.
- +51 SET Z=Z_U_$$TRIM($EXTRACT(Y,379,403))
- +52 ;---> EXTRACT THE HORMONAL EVALUATION NOTATION, TRIM TRAILING SPACES.
- +53 SET Z=Z_U_$$TRIM($EXTRACT(Y,404,428))
- +54 ;---> EXTRACT THE COMMENT, TRIM TRAILING SPACES.
- +55 SET Z=Z_U_$$TRIM($EXTRACT(Y,429,453))
- +56 ;---> EXTRACT THE REVIEWER, TRIM TRAILING SPACES.
- +57 SET LINE=Z_U_$$TRIM($EXTRACT(Y,454,478))
- SET PIECE=1
- +58 QUIT
- +59 ;
- 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 ;---> "TRANS" FORMATS AND TRANSFERS ENTRIES FROM THE "BW UPLD RESULTS
- +3 ;---> TEMP (CORNING)" FILE INTO THE WP FIELD OF THE "BW PROCEDURE"
- +4 ;---> FILE. MATCHING IS DONE ON THE BASIS OF THE ACCESSION#, THE "B"
- +5 ;---> CROSSREFERENCE.
- +6 ;---> BWY WILL EQUAL THE IEN OF THE PROCEDURE, FILE 9002086.1.
- +7 ;---> BWYY WILL EQUAL THE IEN OF THE LAB RESULT, FILE 9002086.82.
- +8 NEW BWAGENCY,BWDFN,BWHRCN,BWSSN,BWY,BWYY
- +9 SET (BWMATCH,BWNOMAT)=0
- SET BWTAB=" "
- +10 WRITE !?5,"Transferring to ""BW PROCEDURE"" FILE..."
- HANG 1
- +11 SET BWYY=0
- +12 FOR
- SET BWYY=$ORDER(^BWRNI(BWYY))
- IF 'BWYY
- QUIT
- Begin DoDot:1
- +13 ;---> GET ACCESSION#, CHART#, AND SSN# FROM LAB RESULT.
- +14 SET BWACC=$PIECE(^BWRNI(BWYY,0),U)
- SET BWHRCN=$PIECE(^(0),U,7)
- SET BWSSN=$PIECE(^(0),U,3)
- +15 ;
- +16 ;---> GET IEN OF THE PROCEDURE, FILE 9002086.1, FOR THIS ACCESSION#.
- +17 SET BWY=$ORDER(^BWPCD("B",BWACC,0))
- +18 ;
- +19 ;---> XREF FAILED TO PRODUCE IEN IN PROCEDURE FILE (^BWPCD).
- +20 IF BWY=""
- DO NOMATCH^BWUPTRAN(BWYY,1)
- QUIT
- +21 IF '$DATA(^BWPCD(BWY,0))
- DO NOMATCH^BWUPTRAN(BWYY,1)
- QUIT
- +22 ;
- +23 ;---> GET DFN AND AGENCY (IHS, STATE, OR VA).
- +24 SET BWDFN=$PIECE(^BWPCD(BWY,0),U,2)
- +25 SET BWAGENCY=$$AGENCY^BWUTL5(DUZ(2))
- +26 ;
- +27 ;---> IF AGENCY IS IHS AND THE CHART# FOR THIS RESULT DOES NOT
- +28 ;---> MATCH CHART# FOR THIS PATIENT, STORE RESULT AS UNMATCHED.
- +29 IF BWAGENCY="i"
- IF $$HRCN1^BWUTL1(BWDFN,DUZ(2))'=+BWHRCN
- Begin DoDot:2
- +30 DO NOMATCH^BWUPTRAN(BWYY,3)
- End DoDot:2
- QUIT
- +31 ;
- +32 ;---> FOR NON-IHS AGENCY, IF SSN# FOR THIS RESULT DOES NOT
- +33 ;---> MATCH SSN# FOR THIS PATIENT, STORE RESULT AS UNMATCHED.
- +34 IF BWAGENCY'="i"
- IF $$SSN^BWUTL1(BWDFN)'=+BWSSN
- Begin DoDot:2
- +35 DO NOMATCH^BWUPTRAN(BWYY,6)
- End DoDot:2
- QUIT
- +36 ;
- +37 ;---> TEXT ALREADY STORED FOR THIS IEN IN PROCEDURE FILE (^BWPCD).
- +38 IF $ORDER(^BWPCD(BWY,1,0))
- DO NOMATCH^BWUPTRAN(BWYY,2)
- QUIT
- +39 ;
- +40 ;---> TRANSFER THIS LAB RESULT INTO IT'S PROCEDURE.
- +41 DO TRANSFER^BWUPTRAN(BWYY,BWY)
- +42 ;
- End DoDot:1
- +43 WRITE !?5,"Number of results successfully matched: ",BWMATCH
- +44 WRITE !?5,"Number of results NOT matched.........: ",BWNOMAT,!
- +45 QUIT
