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

PXBSTOR.m

Go to the documentation of this file. 
  1. PXBSTOR ;ISL/JVS - PASSING THE DATA TO THE V FILES ;7/24/96  10:29
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88**;Aug 12, 1996
  1.  ;
  1.  ;
  1.  ;  VARIABLE LIST
  1.  ;  PEICE   1        2     3     4      5     6       7       8       9
  1.  ;  REQ*=PROVDER^PRIMARY^CPT^QUANTITY^POV^PRIMARY^PRV IEN^CPT IEN^POV IEN
  1.  ;  PEICE   10       11
  1.  ;  REQ  STOPCODE^STOPCODE IEN
  1.  ;  REQ(1,MODIFIER)*=""
  1.  ;  REQ("IEN")=V CPT file IEN
  1.  ;  REQI=Internal Values
  1.  ;  REQE=External Values
  1.  ;  PXBVST=Visit Ien
  1.  ;  PRVIEN=Provider IEN in V Provider file
  1.  ;  CPTIEN=CPT IEN in the V CPT file
  1.  ;  POVIEN=POV INE in the V POV file
  1.  ;  patient is defined form the visit
  1.  ;
  1. EN0(PXBVST,PATIENT,REQI,REQ) ;--Main Entry point
  1. EN1 ;
  1.  Q:'$D(REQI)
  1.  K ^TMP("PXK",$J) ;--MUST BE MOVED TO AFTER THE EVENT
  1.  N PRVIEN,CPTIEN,POVIEN,PRVBEF,CPTBEF,POVBEF,PPRNARR,CPRNARR
  1.  N POVBEF12,PRVAFT,PRVAFT12,PRVBEF12
  1.  N CPTAFT,CPTAFT1,CPTBEF1,CPTAFT12,CPTBEF12
  1.  N POVAFT12,POVAFT,POVI
  1.  N PRVBF812,CPTBF812,POVBF812,PRVAF812,CPTAF812,POVAF812
  1.  N SEQ
  1. IEN ;--SET IENS OF EACH FILE
  1.  S PRVIEN=$P(REQI,"^",7) I PRVIEN]"" D
  1.  .S PRVBEF=$G(^AUPNVPRV($P(REQI,"^",7),0))
  1.  .S PRVBEF12=$G(^AUPNVPRV($P(REQI,"^",7),12))
  1.  .S PRVBF812=$G(^AUPNVPRV($P(REQI,"^",7),812))
  1.  E  S (PRVBEF,PRVBEF12,PRVBF812)=""
  1.  S CPTIEN=$P(REQI,"^",8)
  1.  I CPTIEN]"" D
  1.  .S CPTBEF=$G(^AUPNVCPT($P(REQI,"^",8),0))
  1.  .;Build array for cpt modifiers
  1.  .N SUBIEN
  1.  .S SUBIEN=0
  1.  .F  S SUBIEN=$O(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN)) Q:'SUBIEN  D
  1.  ..S CPTBEF1(SUBIEN)=$G(^AUPNVCPT($P(REQI,"^",8),1,SUBIEN,0))
  1.  .S CPTBEF12=$G(^AUPNVCPT($P(REQI,"^",8),12))
  1.  .S CPTBF812=$G(^AUPNVCPT($P(REQI,"^",8),812))
  1.  E  S (CPTBEF,CPTBEF12,CPTBF812)=""
  1.  S POVIEN=$P(REQI,"^",9) I POVIEN]"" D
  1.  .S POVBEF=$G(^AUPNVPOV($P(REQI,"^",9),0))
  1.  .S POVBEF12=$G(^AUPNVPOV($P(REQI,"^",9),12))
  1.  .S POVBF812=$G(^AUPNVPOV($P(REQI,"^",9),812))
  1.  E  S (POVBEF,POVBEF12,POVBF812)=""
  1.  ;
  1. SET ;--SET TEMP GLOBALS
  1.  D MISC
  1.  I '$D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=1
  1.  I $D(^TMP("PXBSTOR",$J,"SEQ")) S SEQ=^TMP("PXBSTOR",$J,"SEQ")
  1.  D:$P(REQI,"^",1) PRV S SEQ=SEQ+1
  1.  D:$P(REQI,"^",3) CPT S SEQ=SEQ+1
  1.  D:$P(REQI,"^",5) POV S SEQ=SEQ+1
  1.  S ^TMP("PXBSTOR",$J,"SEQ")=SEQ+1
  1.  Q
  1. MISC ;--SET MISCELLANEOUS TEMP NODES
  1.  ;--*** CONDITION THE SOURCE
  1.  I '$G(SOURCE) S ^TMP("PXK",$J,"SOR")=$O(^PX(839.7,"B","SD/PCE-INTERFACE-PROMPTS",0))
  1.  ;-------------
  1.  S ^TMP("PXK",$J,"VST",1,"IEN")=PXBVST
  1.  S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$G(^AUPNVSIT(PXBVST,0))
  1.  S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXBVST,0))
  1.  Q
  1.  ;
  1. PRV ;--PROVIDER PIECE 1 AND 2
  1.  S PRVAFT=PRVBEF,PRVAFT12=PRVBEF12,PRVAF812=PRVBF812
  1.  I $D(DELM),$P(DELM,"^",1)=1 S (PRVAFT,PRVAFT12)="" G PRV1
  1.  S $P(PRVAFT,"^",1)=$P(REQI,"^",1) ;--PROVIDER IEN
  1.  S $P(PRVAFT,"^",4)=$P(REQI,"^",2) ;--PRIMARY/SECONDARY
  1.  S $P(PRVAFT,"^",2)=PATIENT ;--PATIENT
  1.  S $P(PRVAFT,"^",3)=PXBVST ;--VISIT POINTER
  1.  I PRVBF812']"" D
  1.  .;-***POPULATE VERIFIED FIELD IN FUTURE
  1.  .S $P(PRVAF812,"^",2)=$G(PXBPKG)
  1.  .S $P(PRVAF812,"^",3)=$G(PXBSOURC)
  1. PRV1 S ^TMP("PXK",$J,"PRV",SEQ,0,"AFTER")=PRVAFT
  1.  S ^TMP("PXK",$J,"PRV",SEQ,0,"BEFORE")=PRVBEF
  1.  S ^TMP("PXK",$J,"PRV",SEQ,12,"AFTER")=PRVAFT12
  1.  S ^TMP("PXK",$J,"PRV",SEQ,12,"BEFORE")=PRVBEF12
  1.  S ^TMP("PXK",$J,"PRV",SEQ,812,"AFTER")=PRVAF812
  1.  S ^TMP("PXK",$J,"PRV",SEQ,812,"BEFORE")=PRVBF812
  1.  S ^TMP("PXK",$J,"PRV",SEQ,"IEN")=PRVIEN
  1.  Q
  1.  ;
  1. CPT ;--CPT PROCDEURE PIECE 3 AND 4 AND
  1.  N PXMODIEN
  1.  S CPTAFT=CPTBEF,CPTAFT12=CPTBEF12,CPTAF812=CPTBF812
  1.  I $D(DELM),$P(DELM,"^",2)=1 S (CPTAFT,CPTAFT12)="" G CPT1
  1.  S $P(CPTAFT,"^",1)=$P(REQI,"^",3) ;--PROCEDURE IEN 
  1.  S $P(CPTAFT,"^",2)=PATIENT ;--PATIENT
  1.  S $P(CPTAFT,"^",3)=PXBVST ;--VISIT POINTER
  1.  S $P(CPTAFT12,"^",4)=$P(REQI,"^",1) ;--PROVIDER POINTER
  1.  S CPRNARR=$$EXTTEXT^PXUTL1($P(REQI,"^",3),1,81,2) ;--TEXT PROV NARR
  1.  S $P(CPTAFT,"^",4)=+$$PROVNARR^PXAPI($G(CPRNARR),9000010.18) ;--PROV NAR
  1.  S $P(CPTAFT,"^",16)=$P(REQI,"^",4) ;--QUANTITY
  1.  I $P(REQI,"^",4)=0 S (CPTAFT,CPTAFT12)=""
  1.  I $P(REQI,"^",4)="@" S (CPTAFT,CPTAFT12)=""
  1.  ;--------------------
  1.  ;I $G(CPTIEN),$D(^AUPNVCPT(CPTIEN,12)),$P(REQI,"^",1)'=$P(^AUPNVCPT(CPTIEN,12),"^",4),'$D(DELM) S (CPTIEN,CPTBEF,CPTBEF12)=""
  1.  ;---------------
  1.  I CPTBF812']"" D
  1.  .;-***POPULATE VERIFIED FIELD IN FUTURE
  1.  .S $P(CPTAF812,"^",2)=$G(PXBPKG)
  1.  .S $P(CPTAF812,"^",3)=$G(PXBSOURC)
  1.  S PXMODIEN=""
  1.  F  S PXMODIEN=$O(REQ(1,PXMODIEN)) Q:PXMODIEN=""  D
  1.  .S CPTAFT1(PXMODIEN)=REQ(1,PXMODIEN)
  1. CPT1 ;
  1.  S ^TMP("PXK",$J,"CPT",SEQ,0,"AFTER")=CPTAFT
  1.  S ^TMP("PXK",$J,"CPT",SEQ,0,"BEFORE")=CPTBEF
  1.  S ^TMP("PXK",$J,"CPT",SEQ,12,"AFTER")=CPTAFT12
  1.  S ^TMP("PXK",$J,"CPT",SEQ,12,"BEFORE")=CPTBEF12
  1.  S ^TMP("PXK",$J,"CPT",SEQ,812,"AFTER")=CPTAF812
  1.  S ^TMP("PXK",$J,"CPT",SEQ,812,"BEFORE")=CPTBF812
  1.  S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=CPTIEN
  1.  ;Set modifiers into ^TMP
  1.  S PXMODIEN=""
  1.  F  S PXMODIEN=$O(CPTAFT1(PXMODIEN)) Q:PXMODIEN=""  D
  1.  .S ^TMP("PXK",$J,"CPT",SEQ,1,PXMODIEN,"AFTER")=CPTAFT1(PXMODIEN)
  1.  S PXMODIEN=""
  1.  F  S PXMODIEN=$O(CPTBEF1(PXMODIEN)) Q:PXMODIEN=""  D
  1.  .S ^TMP("PXK",$J,"CPT",SEQ,1,PXMODIEN,"BEFORE")=CPTBEF1(PXMODIEN)
  1.  ;Set ^TMP file with V CPT IEN
  1.  I $G(REQ)]"" D
  1.  . S ^TMP("PXK",$J,"CPT",SEQ,"IEN")=REQ
  1.  Q
  1.  ;
  1. POV ;--POV PIECE 5 AND 6 AND
  1.  S POVAFT=POVBEF,POVAFT12=POVBEF12,POVAF812=PRVBF812
  1.  I $D(DELM),$P(DELM,"^",3)=1 S (POVAFT,POVAFT12)="" G POV1
  1.  S $P(POVAFT,"^",1)=$P(REQI,"^",5) ;--POV IEN 
  1.  S $P(POVAFT,"^",12)=$P(REQI,"^",6) ;--PRI/SECONDARY
  1.  S $P(POVAFT,"^",2)=PATIENT ;--PATIENT
  1.  S $P(POVAFT,"^",3)=PXBVST ;--VISIT POINTER
  1.  S PPRNARR=$$EXTTEXT^PXUTL1($P(REQI,"^",5),1,80,10) ;--TEXT PROV NARR
  1.  S $P(POVAFT,"^",4)=+$$PROVNARR^PXAPI($G(PPRNARR),9000010.07) ;--POI PROV NARR
  1.  I $P($G(REQI),"^",7) S $P(POVAFT12,"^",4)=$P(^AUPNVPRV($P(REQI,"^",7),0),"^",1) ;--PROVIDER
  1.  I $G(PXBRES) S $P(POVAFT,"^",16)=PXBRES ;-PROBLEM LIST ENTRY
  1.  I POVBF812']"" D
  1.  .;-**POPULATE VERIFIED FIELD IN FUTURE
  1.  .S $P(POVAF812,"^",2)=$G(PXBPKG)
  1.  .S $P(POVAF812,"^",3)=$G(PXBSOURC)
  1. POV1 S ^TMP("PXK",$J,"POV",SEQ,0,"AFTER")=POVAFT
  1.  S ^TMP("PXK",$J,"POV",SEQ,0,"BEFORE")=POVBEF
  1.  S ^TMP("PXK",$J,"POV",SEQ,12,"AFTER")=POVAFT12
  1.  S ^TMP("PXK",$J,"POV",SEQ,12,"BEFORE")=POVBEF12
  1.  S ^TMP("PXK",$J,"POV",SEQ,812,"AFTER")=POVAF812
  1.  S ^TMP("PXK",$J,"POV",SEQ,812,"BEFORE")=POVBF812
  1.  S ^TMP("PXK",$J,"POV",SEQ,"IEN")=POVIEN
  1.  Q