- 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
