Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWPCC

BWPCC.m

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