BWPCC ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK [ 08/16/01 3:50 PM ];05-Feb-2003 08:39;PLS
;;2.0;WOMEN'S HEALTH;**7,8,10,13**;APR 19, 1996;Build 9
;IHS/CMI/LAB - modified VPROC for CSV *10*
;IHS/CMI/LAB - modified provider lookup for file 6/200
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CREATE/EDIT A VISIT FILE ENTRY, CREATE A V FILE ENTRY.
;; CALLED BY BWPROC1.
;
CREATE(BWDA,BWDUZ2,BW0) ;EP
;---> CREATE A VISIT FILE ENTRY, CREATE A V FILE ENTRY.
;---> CALLED BY BWPROC1.
;---> REQUIRED VARIABLES: BWDA=IEN OF PROCEDURE IN ^BWPCD(.
;---> BWDUZ2=DUZ(2), THE FACILITY.
;---> BW0=ZERO NODE OF THE PROC, ^BWPCD(BWDA,0).
;
;S DUZ(0) ="@" ;*COMEBACK ;FOR ANMC PART III SECURITY.
;
;---> QUIT IF NECESSARY VARIABLES ARE NOT PRESENT.
Q:'$G(BWDA)!('$G(BWDUZ2))!($G(BW0)']"")
;
N BWERR,BWPCDN,BWSITE,BWVFIL
;---> SET BWPCDN=IEN OF PROCEDURE TYPE, ^BWPN(.
;---> SET BWSITE=IEN OF FACILITY WHERE PROCEDURE WAS PERFORMED.
;---> SET BWVFIL=IEN OF V FILE.
S BWPCDN=$P(BW0,U,4),BWSITE=$P(BW0,U,10)
Q:'BWPCDN ; Procedure Type is required
S BWVFIL=$P($G(^BWPN(BWPCDN,0)),U,12)
;
;---> IF THIS PROCEDURE WON'T GET PASSED TO PCC, BWERR WILL BE
;---> GREATER THAN 0: SO, DISPLAY ERROR CODE TEXT AND QUIT.
S BWERR=$$CHECK^BWPCC1(BW0,DUZ(0),BWDUZ2,BWPCDN,BWSITE,BWVFIL)
I BWERR D:$P(^BWSITE(DUZ(2),0),U,20) ERRCD^BWUTL2(BWERR) Q
;
W !?5,"* Updating PCC Files..."
;
K APCDALVR N BWTEST,X
;
VISIT ;---> CREATE OR MODIFY VISIT IN VISIT FILE.
;---> SET BWTEST=1 TO DISPLAY VISIT AND V RAD PTRS AFTER SET.
S BWTEST=0
;
;---> PATIENT
S APCDALVR("APCDPAT")=$P(BW0,U,2)
;
;---> PCC DATE/TIME; IF NO TIME, ATTACH 12 NOON.
S APCDALVR("APCDDATE")=$P(BW0,U,3)
;
;---> LOCATION
S APCDALVR("APCDLOC")=$P(BW0,U,10)
;
;---> VISIT TYPE FROM PCC MASTER CONTROL FILE. (I,C,T,6,V)
S APCDALVR("APCDTYPE")=$P(^APCCCTRL(DUZ(2),0),U,4)
;
;---> APPEND 12 NOON TO ANY VISIT WITHOUT TIME.
;S APCDALVR("APCDAUTO")=""
;---> FOR NOW, LEAVE IN INTERACTIVE MODE:
;---> 1) IF NO VISIT EXISTS ON THIS DATE, CREATE ONE SILENTLY.
;---> 2) IF A VISIT EXISTS WITH EXACT TIME MATCH, APPEND TO IT.
;---> 3) IF A VISIT EXISTS FOR THIS DATE BUT A DIFFERENT TIME,
;---> 4) THEN QUERY THE USER IN INTERACTIVE MODE.
;
;---> CATEGORY
;---> IF PROCEDURE WAS DONE OFFSITE, CATEGORY="EVENT".
;---> IF ^BWPN( IENS OF 3=HYSTERECTOMY, 33=MASTECTOMY, CAT="INPATIENT".
;---> OTHERWISE, CATEGORY="AMBULATORY".
S APCDALVR("APCDCAT")=$S(BWSITE'=BWDUZ2:"E",33[BWPCDN:"I",1:"A")
;
;---> NO INTERACTION, NO FILEMAN ECHOING
S APCDALVR("AUPNTALK")="",APCDALVR("APCDANE")=""
;
D ^APCDALV
D:BWTEST DISPLAY1^BWPCC1
;
;---> QUIT IF VISIT WAS NOT CREATED.
I '$D(APCDALVR("APCDVSIT"))!($D(APCDALVR("APCDAFLG"))) D G EXIT
.W !!?5,"* There is a PCC Link problem creating a VISIT."
.W !,?7,"Please contact your site manager.",! D DIRZ^BWUTL3
;
;RETURNS APCDVSIT - PTR TO VISIT JUST SELECTED OR CREATED
; APCDVSIT("NEW") - IF ^APCDALVR CREATED A NEW VISIT
; APCDAFLG - =2 IF FAILED TO CREATE VISIT
;
VFILE ;---> CREATE (ADD) VISIT TO APPROPRIATE V FILE.
;---> V FILE#=PIECE 15 OF BW PROCEDURE TYPE.
S DLAYGO=BWVFIL
;
;---> CLINIC STOP.
S X=$P(BW0,U,11)
S:X X=$P($G(^SC(X,0)),U,7)
S:X APCDALVR("APCDTCLN")="`"_X K X
;
;---> WOMEN'S HEALTH PROCEDURE EVENT DATE/TIME.
;---> *NOTE: EVENT DATE/TIME MAY DIFFER FROM PCC DATE/TIME (PC 3).
S APCDALVR("APCDTCDT")=$P(BW0,U,12)
;
;---> SET APPROPRIATE V FILE VARIABLES.
D
.I BWVFIL=9000010.08 D VPROC Q
.I BWVFIL=9000010.09 D VLAB Q
.I BWVFIL=9000010.13 D VEXAM Q
.I BWVFIL=9000010.22 D VRAD Q
.I BWVFIL=9000010.18 D VCPT Q
;
;---> TEMPLATE TO ADD VISIT TO V WOMEN'S HEALTH FILE.
S APCDALVR("APCDATMP")="[APCDALVR "_BWVFIL_" (ADD)]"
D ^APCDALVR
D:BWTEST DISPLAY2^BWPCC1
;
;---> QUIT IF V FILE ENTRY WAS NOT CREATED.
I '$D(APCDALVR("APCDADFN"))!($D(APCDALVR("APCDAFLG"))) D G EXIT
.W !!?5,"* There is a PCC Link problem creating V FILE entries."
.W !,?7,"Please contact your site manager.",! D DIRZ^BWUTL3
;
STORE ;---> STORE VISIT AND V FILE IEN'S IN WH PROCEDURE FILE #9002086.1.
I $G(BWDA) D
.N DR
.S DR="5.01////"_APCDALVR("APCDVSIT")_";5.02////"_APCDALVR("APCDADFN")
.D DIE^BWFMAN(9002086.1,DR,BWDA,.BWPOP)
D:BWTEST DISPLAY3^BWPCC1
;
EXIT ;EP
K APCDALVR,AUPNTALK,APCDALVR
Q
;
;
EDIT(BWDA,BWDUZ2,BW0,BWPCCN) ;EP
;---> EDIT A VISIT FILE ENTRY, CREATE A V FILE ENTRY.
;---> CALLED BY BWPROC1.
;---> REQUIRED VARIABLES: BWDA=IEN OF PROCEDURE IN ^BWPCD(.
;---> BWDUZ2=DUZ(2), THE FACILITY.
;---> BW0=ZERO NODE OF THE PROC, ^BWPCD(BWDA,0).
;---> BWPCCN=PCC NODE OF THE PROCEDURE.
;
;S DUZ(0) ="@" ;*COMEBACK ;FOR ANMC PART III SECURITY.
;
;---> QUIT IF NECESSARY VARIABLES ARE NOT PRESENT.
Q:'$G(BWDA)!('$G(BWDUZ2))!($G(BW0)']"")!($G(BWPCCN)']"")
;
N BWPCDN,BWSITE,BWVFIL
;---> SET BWPCDN=IEN OF PROCEDURE TYPE, ^BWPN(.
;---> SET BWVFIL=IEN OF V FILE.
S BWPCDN=$P(BW0,U,4),BWSITE=$P(BW0,U,10)
S BWVFIL=$P($G(^BWPN(BWPCDN,0)),U,12)
;
;---> IF THIS PROCEDURE WON'T GET PASSED TO PCC, BWERR WILL BE
;---> GREATER THAN 0: SO, DISPLAY ERROR CODE TEXT AND QUIT.
S BWERR=$$CHECK^BWPCC1(BW0,DUZ(0),BWDUZ2,BWPCDN,BWSITE,BWVFIL)
;---> IF RESULT WAS EDITED TO "ERROR/DISREGARD", THEN DELETE
;---> VISIT AND QUIT (DON'T CREATE A NEW ONE).
I BWERR=2 D Q
.D DELETE(BWDA,BWPCCN,BWVFIL)
.D:$P(^BWSITE(DUZ(2),0),U,20) ERRCD^BWUTL2(BWERR)
I BWERR D:$P(^BWSITE(DUZ(2),0),U,20) ERRCD^BWUTL2(BWERR) Q
;
D DELETE(BWDA,BWPCCN,BWVFIL)
D CREATE(BWDA,BWDUZ2,BW0)
Q
;
DELETE(BWDA,BWPCCN,BWVFIL) ;EP ;---> DELETE PCC V FILE ENTRY.
N BWVGBL,DA,DIK
Q:'$G(BWPCCN) Q:'$G(BWVFIL)
S DA=$P(BWPCCN,U,2)
;---> QUIT IF POINTER TO V FILE IS NULL.
Q:'+DA
S BWVGBL=^DIC(BWVFIL,0,"GL")
;---> IF V FILE ENTRY DOES NOT EXIST, KILL WH PCC NODE AND QUIT.
I '$D(@(BWVGBL_DA_",0)")) K:$G(BWDA) ^BWPCD(BWDA,"PCC") Q
;
S APCDVDLT=$P(@(BWVGBL_DA_",0)"),U,3)
;---> FIRST DELETE THE V FILE ENTRY (AND DECREMENT THE DEPENDENT
;---> ENTRY COUNT OF THE VISIT).
S DIK=BWVGBL D ^DIK
Q:APCDVDLT'=$P(BWPCCN,U)
;---> ASK LORI WHAT THIS NEXT LINE DOES? DECREMENT/INACTIVATE VISIT?
D:'$P(^AUPNVSIT(APCDVDLT,0),U,9) ^APCDVDLT
;---> SET PCC VISIT POINTERS FOR THIS PROCEDURE= NULL.
K:$G(BWDA) ^BWPCD(BWDA,"PCC")
Q
;
VPROC ;EP
;---> SET UP V PROCEDURE FILE VARIABLES.
;---> PROCEDURE (.01).
N BWICD S BWICD=$P(^BWPN(BWPCDN,0),U,14)
S APCDALVR("APCDTPRC")="`"_BWICD
;---> PROVIDER NARRATIVE.
;IHS/CMI/LAB - commented out line below for CSV 5/5/09
;and replaced it with call to ICDCODE
;S APCDALVR("APCDTNQ")=$P(^ICD0(BWICD,0),U,4)
S APCDALVR("APCDTNQ")=$P($$ICDOP^ICDCODE(BWICD,$P(BW0,U,12)),U,5)
;---> DATE OF PROCEDURE.
S APCDALVR("APCDTPD")=$P(BW0,U,12)
;---> ENCOUNTER PROVIDER.
N X S X=$$PROVIDER(BW0,9000010.08,1204) S:X APCDALVR("APCDTEPR")="`"_X
Q
;
VLAB ;EP
;---> SET UP V LAB FILE VARIABLES.
;---> LAB TEST (.01).
S APCDALVR("APCDTLAB")="`"_$P(^BWPN(BWPCDN,0),U,15)
;---> RESULT.
N X S X=$$DIAG^BWUTL4($P(BW0,U,5))
S APCDALVR("APCDTRES")=$S(X]"":X,1:"RESULT NOT ENTERED")
;---> ACCESSION# PREFIXED WITH "WH".
S APCDALVR("APCDTACC")="WH"_$P(BW0,U)
;---> ENCOUNTER PROVIDER.
N X S X=$$PROVIDER(BW0,9000010.09,1204) S:X APCDALVR("APCDTEPR")="`"_X
Q
;
VEXAM ;EP
;---> SET UP V EXAM FILE VARIABLES.
;---> EXAM (.01).
S APCDALVR("APCDTEX")="`"_$P(^BWPN(BWPCDN,0),U,16)
;---> RESULT ABNORMAL/NORMAL.
N X S X=$$NORMAL^BWUTL4($P(BW0,U,5))
S:X<2 APCDALVR("APCDTRES")=$S(X:"A",1:"N")
;---> ENCOUNTER PROVIDER.
N X S X=$$PROVIDER(BW0,9000010.13,1204) S:X APCDALVR("APCDTEPR")="`"_X
Q
;
VRAD ;EP
;---> SET UP V RADIOLOGY FILE VARIABLES.
;---> RADIOLOGY PROCEDURE (.01).
S APCDALVR("APCDTRAD")="`"_$P(^BWPN(BWPCDN,0),U,17)
;
;---> RESULT *COMEBACK AFTER FILE #78.3 DIAG CODES HAS STANDARDIZED.
;---> FOR NOW, PASS RESULT TEXT (FROM ^BWDIAG) AS IMPRESSION.
N X S X=$P(BW0,U,5)
;I X S:$D(^BWRADX(X,0)) APCDALVR("APCDTRES")="`"_$P(^(0),U,2)
;---> IMPRESSION
S:X APCDALVR("APCDTIMP")=$$DIAG^BWUTL4(X)
;
;---> ORDERING PROVIDER.
S X=$$PROVIDER(BW0,9000010.22,1202) S:X APCDALVR("APCDTPRV")="`"_X
Q
;
VCPT ;EP
S APCDALVR("APCDTCPT")="`"_$P(^BWPN(BWPCDN,0),U,8)
N X S X=$$PROVIDER(BW0,9000010.13,1204) S:X APCDALVR("APCDTEPR")="`"_X
S APCDALVR("APCDTPN")=$$ICPT^BQIUL3($P(^BWPN(BWPCDN,0),U,8),$P(BW0,U,3),3)
Q
;
PROVIDER(BW0,FILE,FIELD) ;EP
Q:$G(BW0)="" ""
Q:$G(FILE)="" ""
Q:$G(FIELD)="" ""
S X=$P(BW0,U,7)
Q:'X ""
;---> IF PCC WANTS A FILE 6 POINTER FOR PROVIDER, RESET X.
I $P(^DD(FILE,FIELD,0),U,2)[6 D
.I $P($G(^VA(200,X,0)),U,16) S X=$P(^(0),U,16) Q
.S X=$P($G(^DIC(3,X,0)),U,16)
Q X
BWPCC ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK [ 08/16/01 3:50 PM ];05-Feb-2003 08:39;PLS
+1 ;;2.0;WOMEN'S HEALTH;**7,8,10,13**;APR 19, 1996;Build 9
+2 ;IHS/CMI/LAB - modified VPROC for CSV *10*
+3 ;IHS/CMI/LAB - modified provider lookup for file 6/200
+4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+5 ;; CREATE/EDIT A VISIT FILE ENTRY, CREATE A V FILE ENTRY.
+6 ;; CALLED BY BWPROC1.
+7 ;
CREATE(BWDA,BWDUZ2,BW0) ;EP
+1 ;---> CREATE A VISIT FILE ENTRY, CREATE A V FILE ENTRY.
+2 ;---> CALLED BY BWPROC1.
+3 ;---> REQUIRED VARIABLES: BWDA=IEN OF PROCEDURE IN ^BWPCD(.
+4 ;---> BWDUZ2=DUZ(2), THE FACILITY.
+5 ;---> BW0=ZERO NODE OF THE PROC, ^BWPCD(BWDA,0).
+6 ;
+7 ;S DUZ(0) ="@" ;*COMEBACK ;FOR ANMC PART III SECURITY.
+8 ;
+9 ;---> QUIT IF NECESSARY VARIABLES ARE NOT PRESENT.
+10 IF '$GET(BWDA)!('$GET(BWDUZ2))!($GET(BW0)']"")
QUIT
+11 ;
+12 NEW BWERR,BWPCDN,BWSITE,BWVFIL
+13 ;---> SET BWPCDN=IEN OF PROCEDURE TYPE, ^BWPN(.
+14 ;---> SET BWSITE=IEN OF FACILITY WHERE PROCEDURE WAS PERFORMED.
+15 ;---> SET BWVFIL=IEN OF V FILE.
+16 SET BWPCDN=$PIECE(BW0,U,4)
SET BWSITE=$PIECE(BW0,U,10)
+17 ; Procedure Type is required
IF 'BWPCDN
QUIT
+18 SET BWVFIL=$PIECE($GET(^BWPN(BWPCDN,0)),U,12)
+19 ;
+20 ;---> IF THIS PROCEDURE WON'T GET PASSED TO PCC, BWERR WILL BE
+21 ;---> GREATER THAN 0: SO, DISPLAY ERROR CODE TEXT AND QUIT.
+22 SET BWERR=$$CHECK^BWPCC1(BW0,DUZ(0),BWDUZ2,BWPCDN,BWSITE,BWVFIL)
+23 IF BWERR
IF $PIECE(^BWSITE(DUZ(2),0),U,20)
DO ERRCD^BWUTL2(BWERR)
QUIT
+24 ;
+25 WRITE !?5,"* Updating PCC Files..."
+26 ;
+27 KILL APCDALVR
NEW BWTEST,X
+28 ;
VISIT ;---> CREATE OR MODIFY VISIT IN VISIT FILE.
+1 ;---> SET BWTEST=1 TO DISPLAY VISIT AND V RAD PTRS AFTER SET.
+2 SET BWTEST=0
+3 ;
+4 ;---> PATIENT
+5 SET APCDALVR("APCDPAT")=$PIECE(BW0,U,2)
+6 ;
+7 ;---> PCC DATE/TIME; IF NO TIME, ATTACH 12 NOON.
+8 SET APCDALVR("APCDDATE")=$PIECE(BW0,U,3)
+9 ;
+10 ;---> LOCATION
+11 SET APCDALVR("APCDLOC")=$PIECE(BW0,U,10)
+12 ;
+13 ;---> VISIT TYPE FROM PCC MASTER CONTROL FILE. (I,C,T,6,V)
+14 SET APCDALVR("APCDTYPE")=$PIECE(^APCCCTRL(DUZ(2),0),U,4)
+15 ;
+16 ;---> APPEND 12 NOON TO ANY VISIT WITHOUT TIME.
+17 ;S APCDALVR("APCDAUTO")=""
+18 ;---> FOR NOW, LEAVE IN INTERACTIVE MODE:
+19 ;---> 1) IF NO VISIT EXISTS ON THIS DATE, CREATE ONE SILENTLY.
+20 ;---> 2) IF A VISIT EXISTS WITH EXACT TIME MATCH, APPEND TO IT.
+21 ;---> 3) IF A VISIT EXISTS FOR THIS DATE BUT A DIFFERENT TIME,
+22 ;---> 4) THEN QUERY THE USER IN INTERACTIVE MODE.
+23 ;
+24 ;---> CATEGORY
+25 ;---> IF PROCEDURE WAS DONE OFFSITE, CATEGORY="EVENT".
+26 ;---> IF ^BWPN( IENS OF 3=HYSTERECTOMY, 33=MASTECTOMY, CAT="INPATIENT".
+27 ;---> OTHERWISE, CATEGORY="AMBULATORY".
+28 SET APCDALVR("APCDCAT")=$SELECT(BWSITE'=BWDUZ2:"E",33[BWPCDN:"I",1:"A")
+29 ;
+30 ;---> NO INTERACTION, NO FILEMAN ECHOING
+31 SET APCDALVR("AUPNTALK")=""
SET APCDALVR("APCDANE")=""
+32 ;
+33 DO ^APCDALV
+34 IF BWTEST
DO DISPLAY1^BWPCC1
+35 ;
+36 ;---> QUIT IF VISIT WAS NOT CREATED.
+37 IF '$DATA(APCDALVR("APCDVSIT"))!($DATA(APCDALVR("APCDAFLG")))
Begin DoDot:1
+38 WRITE !!?5,"* There is a PCC Link problem creating a VISIT."
+39 WRITE !,?7,"Please contact your site manager.",!
DO DIRZ^BWUTL3
End DoDot:1
GOTO EXIT
+40 ;
+41 ;RETURNS APCDVSIT - PTR TO VISIT JUST SELECTED OR CREATED
+42 ; APCDVSIT("NEW") - IF ^APCDALVR CREATED A NEW VISIT
+43 ; APCDAFLG - =2 IF FAILED TO CREATE VISIT
+44 ;
VFILE ;---> CREATE (ADD) VISIT TO APPROPRIATE V FILE.
+1 ;---> V FILE#=PIECE 15 OF BW PROCEDURE TYPE.
+2 SET DLAYGO=BWVFIL
+3 ;
+4 ;---> CLINIC STOP.
+5 SET X=$PIECE(BW0,U,11)
+6 IF X
SET X=$PIECE($GET(^SC(X,0)),U,7)
+7 IF X
SET APCDALVR("APCDTCLN")="`"_X
KILL X
+8 ;
+9 ;---> WOMEN'S HEALTH PROCEDURE EVENT DATE/TIME.
+10 ;---> *NOTE: EVENT DATE/TIME MAY DIFFER FROM PCC DATE/TIME (PC 3).
+11 SET APCDALVR("APCDTCDT")=$PIECE(BW0,U,12)
+12 ;
+13 ;---> SET APPROPRIATE V FILE VARIABLES.
+14 Begin DoDot:1
+15 IF BWVFIL=9000010.08
DO VPROC
QUIT
+16 IF BWVFIL=9000010.09
DO VLAB
QUIT
+17 IF BWVFIL=9000010.13
DO VEXAM
QUIT
+18 IF BWVFIL=9000010.22
DO VRAD
QUIT
+19 IF BWVFIL=9000010.18
DO VCPT
QUIT
End DoDot:1
+20 ;
+21 ;---> TEMPLATE TO ADD VISIT TO V WOMEN'S HEALTH FILE.
+22 SET APCDALVR("APCDATMP")="[APCDALVR "_BWVFIL_" (ADD)]"
+23 DO ^APCDALVR
+24 IF BWTEST
DO DISPLAY2^BWPCC1
+25 ;
+26 ;---> QUIT IF V FILE ENTRY WAS NOT CREATED.
+27 IF '$DATA(APCDALVR("APCDADFN"))!($DATA(APCDALVR("APCDAFLG")))
Begin DoDot:1
+28 WRITE !!?5,"* There is a PCC Link problem creating V FILE entries."
+29 WRITE !,?7,"Please contact your site manager.",!
DO DIRZ^BWUTL3
End DoDot:1
GOTO EXIT
+30 ;
STORE ;---> STORE VISIT AND V FILE IEN'S IN WH PROCEDURE FILE #9002086.1.
+1 IF $GET(BWDA)
Begin DoDot:1
+2 NEW DR
+3 SET DR="5.01////"_APCDALVR("APCDVSIT")_";5.02////"_APCDALVR("APCDADFN")
+4 DO DIE^BWFMAN(9002086.1,DR,BWDA,.BWPOP)
End DoDot:1
+5 IF BWTEST
DO DISPLAY3^BWPCC1
+6 ;
EXIT ;EP
+1 KILL APCDALVR,AUPNTALK,APCDALVR
+2 QUIT
+3 ;
+4 ;
EDIT(BWDA,BWDUZ2,BW0,BWPCCN) ;EP
+1 ;---> EDIT A VISIT FILE ENTRY, CREATE A V FILE ENTRY.
+2 ;---> CALLED BY BWPROC1.
+3 ;---> REQUIRED VARIABLES: BWDA=IEN OF PROCEDURE IN ^BWPCD(.
+4 ;---> BWDUZ2=DUZ(2), THE FACILITY.
+5 ;---> BW0=ZERO NODE OF THE PROC, ^BWPCD(BWDA,0).
+6 ;---> BWPCCN=PCC NODE OF THE PROCEDURE.
+7 ;
+8 ;S DUZ(0) ="@" ;*COMEBACK ;FOR ANMC PART III SECURITY.
+9 ;
+10 ;---> QUIT IF NECESSARY VARIABLES ARE NOT PRESENT.
+11 IF '$GET(BWDA)!('$GET(BWDUZ2))!($GET(BW0)']"")!($GET(BWPCCN)']"")
QUIT
+12 ;
+13 NEW BWPCDN,BWSITE,BWVFIL
+14 ;---> SET BWPCDN=IEN OF PROCEDURE TYPE, ^BWPN(.
+15 ;---> SET BWVFIL=IEN OF V FILE.
+16 SET BWPCDN=$PIECE(BW0,U,4)
SET BWSITE=$PIECE(BW0,U,10)
+17 SET BWVFIL=$PIECE($GET(^BWPN(BWPCDN,0)),U,12)
+18 ;
+19 ;---> IF THIS PROCEDURE WON'T GET PASSED TO PCC, BWERR WILL BE
+20 ;---> GREATER THAN 0: SO, DISPLAY ERROR CODE TEXT AND QUIT.
+21 SET BWERR=$$CHECK^BWPCC1(BW0,DUZ(0),BWDUZ2,BWPCDN,BWSITE,BWVFIL)
+22 ;---> IF RESULT WAS EDITED TO "ERROR/DISREGARD", THEN DELETE
+23 ;---> VISIT AND QUIT (DON'T CREATE A NEW ONE).
+24 IF BWERR=2
Begin DoDot:1
+25 DO DELETE(BWDA,BWPCCN,BWVFIL)
+26 IF $PIECE(^BWSITE(DUZ(2),0),U,20)
DO ERRCD^BWUTL2(BWERR)
End DoDot:1
QUIT
+27 IF BWERR
IF $PIECE(^BWSITE(DUZ(2),0),U,20)
DO ERRCD^BWUTL2(BWERR)
QUIT
+28 ;
+29 DO DELETE(BWDA,BWPCCN,BWVFIL)
+30 DO CREATE(BWDA,BWDUZ2,BW0)
+31 QUIT
+32 ;
DELETE(BWDA,BWPCCN,BWVFIL) ;EP ;---> DELETE PCC V FILE ENTRY.
+1 NEW BWVGBL,DA,DIK
+2 IF '$GET(BWPCCN)
QUIT
IF '$GET(BWVFIL)
QUIT
+3 SET DA=$PIECE(BWPCCN,U,2)
+4 ;---> QUIT IF POINTER TO V FILE IS NULL.
+5 IF '+DA
QUIT
+6 SET BWVGBL=^DIC(BWVFIL,0,"GL")
+7 ;---> IF V FILE ENTRY DOES NOT EXIST, KILL WH PCC NODE AND QUIT.
+8 IF '$DATA(@(BWVGBL_DA_",0)"))
IF $GET(BWDA)
KILL ^BWPCD(BWDA,"PCC")
QUIT
+9 ;
+10 SET APCDVDLT=$PIECE(@(BWVGBL_DA_",0)"),U,3)
+11 ;---> FIRST DELETE THE V FILE ENTRY (AND DECREMENT THE DEPENDENT
+12 ;---> ENTRY COUNT OF THE VISIT).
+13 SET DIK=BWVGBL
DO ^DIK
+14 IF APCDVDLT'=$PIECE(BWPCCN,U)
QUIT
+15 ;---> ASK LORI WHAT THIS NEXT LINE DOES? DECREMENT/INACTIVATE VISIT?
+16 IF '$PIECE(^AUPNVSIT(APCDVDLT,0),U,9)
DO ^APCDVDLT
+17 ;---> SET PCC VISIT POINTERS FOR THIS PROCEDURE= NULL.
+18 IF $GET(BWDA)
KILL ^BWPCD(BWDA,"PCC")
+19 QUIT
+20 ;
VPROC ;EP
+1 ;---> SET UP V PROCEDURE FILE VARIABLES.
+2 ;---> PROCEDURE (.01).
+3 NEW BWICD
SET BWICD=$PIECE(^BWPN(BWPCDN,0),U,14)
+4 SET APCDALVR("APCDTPRC")="`"_BWICD
+5 ;---> PROVIDER NARRATIVE.
+6 ;IHS/CMI/LAB - commented out line below for CSV 5/5/09
+7 ;and replaced it with call to ICDCODE
+8 ;S APCDALVR("APCDTNQ")=$P(^ICD0(BWICD,0),U,4)
+9 SET APCDALVR("APCDTNQ")=$PIECE($$ICDOP^ICDCODE(BWICD,$PIECE(BW0,U,12)),U,5)
+10 ;---> DATE OF PROCEDURE.
+11 SET APCDALVR("APCDTPD")=$PIECE(BW0,U,12)
+12 ;---> ENCOUNTER PROVIDER.
+13 NEW X
SET X=$$PROVIDER(BW0,9000010.08,1204)
IF X
SET APCDALVR("APCDTEPR")="`"_X
+14 QUIT
+15 ;
VLAB ;EP
+1 ;---> SET UP V LAB FILE VARIABLES.
+2 ;---> LAB TEST (.01).
+3 SET APCDALVR("APCDTLAB")="`"_$PIECE(^BWPN(BWPCDN,0),U,15)
+4 ;---> RESULT.
+5 NEW X
SET X=$$DIAG^BWUTL4($PIECE(BW0,U,5))
+6 SET APCDALVR("APCDTRES")=$SELECT(X]"":X,1:"RESULT NOT ENTERED")
+7 ;---> ACCESSION# PREFIXED WITH "WH".
+8 SET APCDALVR("APCDTACC")="WH"_$PIECE(BW0,U)
+9 ;---> ENCOUNTER PROVIDER.
+10 NEW X
SET X=$$PROVIDER(BW0,9000010.09,1204)
IF X
SET APCDALVR("APCDTEPR")="`"_X
+11 QUIT
+12 ;
VEXAM ;EP
+1 ;---> SET UP V EXAM FILE VARIABLES.
+2 ;---> EXAM (.01).
+3 SET APCDALVR("APCDTEX")="`"_$PIECE(^BWPN(BWPCDN,0),U,16)
+4 ;---> RESULT ABNORMAL/NORMAL.
+5 NEW X
SET X=$$NORMAL^BWUTL4($PIECE(BW0,U,5))
+6 IF X<2
SET APCDALVR("APCDTRES")=$SELECT(X:"A",1:"N")
+7 ;---> ENCOUNTER PROVIDER.
+8 NEW X
SET X=$$PROVIDER(BW0,9000010.13,1204)
IF X
SET APCDALVR("APCDTEPR")="`"_X
+9 QUIT
+10 ;
VRAD ;EP
+1 ;---> SET UP V RADIOLOGY FILE VARIABLES.
+2 ;---> RADIOLOGY PROCEDURE (.01).
+3 SET APCDALVR("APCDTRAD")="`"_$PIECE(^BWPN(BWPCDN,0),U,17)
+4 ;
+5 ;---> RESULT *COMEBACK AFTER FILE #78.3 DIAG CODES HAS STANDARDIZED.
+6 ;---> FOR NOW, PASS RESULT TEXT (FROM ^BWDIAG) AS IMPRESSION.
+7 NEW X
SET X=$PIECE(BW0,U,5)
+8 ;I X S:$D(^BWRADX(X,0)) APCDALVR("APCDTRES")="`"_$P(^(0),U,2)
+9 ;---> IMPRESSION
+10 IF X
SET APCDALVR("APCDTIMP")=$$DIAG^BWUTL4(X)
+11 ;
+12 ;---> ORDERING PROVIDER.
+13 SET X=$$PROVIDER(BW0,9000010.22,1202)
IF X
SET APCDALVR("APCDTPRV")="`"_X
+14 QUIT
+15 ;
VCPT ;EP
+1 SET APCDALVR("APCDTCPT")="`"_$PIECE(^BWPN(BWPCDN,0),U,8)
+2 NEW X
SET X=$$PROVIDER(BW0,9000010.13,1204)
IF X
SET APCDALVR("APCDTEPR")="`"_X
+3 SET APCDALVR("APCDTPN")=$$ICPT^BQIUL3($PIECE(^BWPN(BWPCDN,0),U,8),$PIECE(BW0,U,3),3)
+4 QUIT
+5 ;
PROVIDER(BW0,FILE,FIELD) ;EP
+1 IF $GET(BW0)=""
QUIT ""
+2 IF $GET(FILE)=""
QUIT ""
+3 IF $GET(FIELD)=""
QUIT ""
+4 SET X=$PIECE(BW0,U,7)
+5 IF 'X
QUIT ""
+6 ;---> IF PCC WANTS A FILE 6 POINTER FOR PROVIDER, RESET X.
+7 IF $PIECE(^DD(FILE,FIELD,0),U,2)[6
Begin DoDot:1
+8 IF $PIECE($GET(^VA(200,X,0)),U,16)
SET X=$PIECE(^(0),U,16)
QUIT
+9 SET X=$PIECE($GET(^DIC(3,X,0)),U,16)
End DoDot:1
+10 QUIT X
