BWUPTRAN ;IHS/ANMC/MWR - UPLOAD: TRANSFERS WP TEXT;15-Feb-2003 22:13;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; TRANSFERS WP TEXT IN LOCAL ARRAY BW1 TO WP NODE OF PROCEDURE
;; OR IN UNMATCHED LAB RESULTS FILE. CALLED BY BWUPRNI.
;
;
TRANSFER(BWYY,BWY) ;EP
;---> TRANSFERS TEXT OF LAB REPORT FROM BW1(N) LOCAL ARRAY INTO
;---> A BW PROCEDURE FILE ENTRY.
;---> REQUIRED VARIABLES: BWY =IEN OF THE PROCEDURE IN PROCEDURE FILE.
;---> BWYY=IEN OF LAB RESULT, FILE 9002086.82.
;---> OR BWYY="DONE", MEANS BW1 ARRAY EXISTS.
;---> (BW1( LOCAL ARRAY=FORMATTED LINES OF TEXT.)
;--->
;---> CALLED BY BWUPRNI WHEN UPLOADING RESULTS AND MOVING THEM INTO
;---> EXISTING BW PROCEDURES.
;---> ALSO CALLED BY BWUPDISP WHEN MOVING AN UNMATCHED RESULT INTO A
;---> A BW PROCEDURE.
;
N M,N
L +^BWPCD(BWY):5 I '$T S BWPOP=1 D:BWYY'="DONE" NOMATCH(BWYY,4) Q
K ^BWPCD(BWY,1)
D:BWYY'="DONE" FORMAT^BWUPRNI1(BWYY)
S (M,N)=0
F S N=$O(BW1(N)) Q:'N D
.S ^BWPCD(BWY,1,N,0)=BW1(N),M=N
S ^BWPCD(BWY,1,0)="^^"_M_U_M_U_DT
;---> SET STATUS OF THIS PROCEDURE = "NEW" (AND IT'S "S" XREF).
;---> SET THE "DATE RESULTS RECEIVED" FIELD = TODAY.
S DR=".14////"_"n"_";.32////"_DT
D DIE^BWFMAN(9002086.1,DR,BWY,.BWPOP,1) L -^BWPCD(BWY)
S:$D(BWMATCH) BWMATCH=BWMATCH+1
Q
;
;
NOMATCH(BWYY,BWREAS) ;EP
;---> STORE THIS RESULTS REPORT IN "BW UPLD UNMATCHED LAB REPORTS" FILE
;---> VARIABLES: BWYY=IEN OF THE LAB RESULT, FILE 9002086.82.
;---> BWREAS=NUMERIC CODE FOR FAILURE (.02 FLD).
;---> 1=NO MATCH BY ACC#, 2=TEXT ALREADY PRESENT
;---> 3=CHART#'S DON'T MATCH, 4=PROCEDURE LOCKED,
;---> 5=UNKNOWN,6=SSN#'S DON'T MATCH.
;---> BWACC=FREE TEXT OF ACCESSION# IN LAB REPORT.
;---> BWPNAME=FREE TEXT PATIENT NAME.
;---> BW1( LOCAL ARRAY=FORMATTED LINES OF TEXT.
;
Q:'$D(BWYY) Q:+BWYY<1
S BWACC=$P(^BWRNI(BWYY,0),U),BWPNAME=$P(^BWRNI(BWYY,0),U,2)
S:BWPNAME="" BWPNAME="UNKNOWN"
N DIC K DD,DO
W !?10,"FAILED TO ADD/EDIT ",BWACC,"!"
W !?5,"Storing this lab result in BW UPLD UNMATCHED LAB RESULTS FILE."
S:'$D(BWREAS) BWREAS=5
S:BWPNAME="" BWPNAME="UNKNOWN"
S DIC="^BWRUN(",DIC(0)="L",X=BWACC,DLAYGO=9002086
S DIC("DR")=".02////"_BWREAS_";.03////"_BWPNAME
D FILE^DICN
S BWY=+Y
D FORMAT^BWUPRNI1(BWYY)
;---> SET UNMATCHED FILE WP NODES EQUAL TO LAB RESULT (IN BW1(N)).
S (M,N)=0
F S N=$O(BW1(N)) Q:'N D
.S ^BWRUN(BWY,1,N,0)=BW1(N),M=N
S ^BWRUN(BWY,1,0)="^^"_M_U_M_U_DT
S BWNOMAT=BWNOMAT+1
K BWACC,BWNAME
Q
BWUPTRAN ;IHS/ANMC/MWR - UPLOAD: TRANSFERS WP TEXT;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 ;; TRANSFERS WP TEXT IN LOCAL ARRAY BW1 TO WP NODE OF PROCEDURE
+4 ;; OR IN UNMATCHED LAB RESULTS FILE. CALLED BY BWUPRNI.
+5 ;
+6 ;
TRANSFER(BWYY,BWY) ;EP
+1 ;---> TRANSFERS TEXT OF LAB REPORT FROM BW1(N) LOCAL ARRAY INTO
+2 ;---> A BW PROCEDURE FILE ENTRY.
+3 ;---> REQUIRED VARIABLES: BWY =IEN OF THE PROCEDURE IN PROCEDURE FILE.
+4 ;---> BWYY=IEN OF LAB RESULT, FILE 9002086.82.
+5 ;---> OR BWYY="DONE", MEANS BW1 ARRAY EXISTS.
+6 ;---> (BW1( LOCAL ARRAY=FORMATTED LINES OF TEXT.)
+7 ;--->
+8 ;---> CALLED BY BWUPRNI WHEN UPLOADING RESULTS AND MOVING THEM INTO
+9 ;---> EXISTING BW PROCEDURES.
+10 ;---> ALSO CALLED BY BWUPDISP WHEN MOVING AN UNMATCHED RESULT INTO A
+11 ;---> A BW PROCEDURE.
+12 ;
+13 NEW M,N
+14 LOCK +^BWPCD(BWY):5
IF '$TEST
SET BWPOP=1
IF BWYY'="DONE"
DO NOMATCH(BWYY,4)
QUIT
+15 KILL ^BWPCD(BWY,1)
+16 IF BWYY'="DONE"
DO FORMAT^BWUPRNI1(BWYY)
+17 SET (M,N)=0
+18 FOR
SET N=$ORDER(BW1(N))
IF 'N
QUIT
Begin DoDot:1
+19 SET ^BWPCD(BWY,1,N,0)=BW1(N)
SET M=N
End DoDot:1
+20 SET ^BWPCD(BWY,1,0)="^^"_M_U_M_U_DT
+21 ;---> SET STATUS OF THIS PROCEDURE = "NEW" (AND IT'S "S" XREF).
+22 ;---> SET THE "DATE RESULTS RECEIVED" FIELD = TODAY.
+23 SET DR=".14////"_"n"_";.32////"_DT
+24 DO DIE^BWFMAN(9002086.1,DR,BWY,.BWPOP,1)
LOCK -^BWPCD(BWY)
+25 IF $DATA(BWMATCH)
SET BWMATCH=BWMATCH+1
+26 QUIT
+27 ;
+28 ;
NOMATCH(BWYY,BWREAS) ;EP
+1 ;---> STORE THIS RESULTS REPORT IN "BW UPLD UNMATCHED LAB REPORTS" FILE
+2 ;---> VARIABLES: BWYY=IEN OF THE LAB RESULT, FILE 9002086.82.
+3 ;---> BWREAS=NUMERIC CODE FOR FAILURE (.02 FLD).
+4 ;---> 1=NO MATCH BY ACC#, 2=TEXT ALREADY PRESENT
+5 ;---> 3=CHART#'S DON'T MATCH, 4=PROCEDURE LOCKED,
+6 ;---> 5=UNKNOWN,6=SSN#'S DON'T MATCH.
+7 ;---> BWACC=FREE TEXT OF ACCESSION# IN LAB REPORT.
+8 ;---> BWPNAME=FREE TEXT PATIENT NAME.
+9 ;---> BW1( LOCAL ARRAY=FORMATTED LINES OF TEXT.
+10 ;
+11 IF '$DATA(BWYY)
QUIT
IF +BWYY<1
QUIT
+12 SET BWACC=$PIECE(^BWRNI(BWYY,0),U)
SET BWPNAME=$PIECE(^BWRNI(BWYY,0),U,2)
+13 IF BWPNAME=""
SET BWPNAME="UNKNOWN"
+14 NEW DIC
KILL DD,DO
+15 WRITE !?10,"FAILED TO ADD/EDIT ",BWACC,"!"
+16 WRITE !?5,"Storing this lab result in BW UPLD UNMATCHED LAB RESULTS FILE."
+17 IF '$DATA(BWREAS)
SET BWREAS=5
+18 IF BWPNAME=""
SET BWPNAME="UNKNOWN"
+19 SET DIC="^BWRUN("
SET DIC(0)="L"
SET X=BWACC
SET DLAYGO=9002086
+20 SET DIC("DR")=".02////"_BWREAS_";.03////"_BWPNAME
+21 DO FILE^DICN
+22 SET BWY=+Y
+23 DO FORMAT^BWUPRNI1(BWYY)
+24 ;---> SET UNMATCHED FILE WP NODES EQUAL TO LAB RESULT (IN BW1(N)).
+25 SET (M,N)=0
+26 FOR
SET N=$ORDER(BW1(N))
IF 'N
QUIT
Begin DoDot:1
+27 SET ^BWRUN(BWY,1,N,0)=BW1(N)
SET M=N
End DoDot:1
+28 SET ^BWRUN(BWY,1,0)="^^"_M_U_M_U_DT
+29 SET BWNOMAT=BWNOMAT+1
+30 KILL BWACC,BWNAME
+31 QUIT
