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

VAFHCPV.m

Go to the documentation of this file. 
  1. VAFHCPV ;ALB/CM OUTPATIENT PV1 SEGMENT ; 22 Jan 2002 10:28 AM
  1.  ;;5.3;Registration;**91,151,298,494,573**;Aug 13, 1993
  1.  ;
  1.  ;This routine generates the Outpatient PV1 segment
  1.  ;for the Philly project
  1.  ;
  1.  ;07/12/00 ACS - Added Facility and Suffix to sequence 39
  1.  ;
  1. OPV1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM) ;
  1.  ;
  1.  ;B
  1.  ;DFN - Patient File
  1.  ;EVENT - event number from pivot file
  1.  ;EVDT - event date/time in FileMan format
  1.  ;VPTR - variable pointer
  1.  ;PSTSR - string of fields (if null - required fields, if "A" - supported
  1.  ;fields, or string of fields separated by commas")
  1.  ;PNUM - ID # - always 1 (optional)
  1.  ;
  1.  N RESULT
  1.  S RESULT="PV1"_HLFS_HLFS_"O"
  1.  I '$D(DFN)!('$D(EVENT))!('$D(EVDT))!('$D(VPTR)) Q RESULT
  1.  I $D(EVENT) I EVENT'="" S NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
  1.  I $D(EVENT) I EVENT="" K EVENT
  1.  I '$D(EVENT) S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR),EVENT=$P(NODE,":")
  1.  I EVENT<1 Q RESULT
  1.  S NODE=$P(NODE,":",2)
  1.  I NODE="" S REMOVED="Y"
  1.  ;
  1. EN ;
  1.  N PV1,EVTY,LOC,LOOP,HLD,PIVOT,QUOT
  1.  S QUOT=""""""
  1.  I '$D(PNUM) S PNUM=1
  1.  I $G(PSTR)="A" S PSTR=",2,3,7,10,44,45,50,"
  1.  I $G(PSTR)'="" S PSTR=","_PSTR_","
  1.  I $G(PSTR)="" S PSTR=""
  1.  I +PSTR=-1 Q RESULT
  1.  I $D(REMOVED) S $P(PV1,HLFS,50)=+EVENT,$P(PV1,HLFS,2)="O",$P(PV1,HLFS,1)=PNUM,PV1="PV1"_HLFS_PV1 K REMOVED Q PV1
  1.  S (PIVOT,PV1)="",EVTY="O",LOOP=0
  1.  ; Empty PV1 segment:
  1.  S $P(PV1,HLFS,2)="O"
  1.  ;
  1.  ;F  S LOOP=LOOP+1,HLD=$P(PSTR,",",LOOP) Q:HLD=""  D
  1.  ;.I HLD=2 S $P(PV1,HLFS,2)=EVTY Q
  1.  ;.I HLD=3 S $P(PV1,HLFS,3)=$$CLINIC(NODE) Q
  1.  ;.I HLD=7 S $P(PV1,HLFS,7)=$$OUTPRO(NODE) Q
  1.  ;.;patient type for v2.3
  1.  ;.I HLD=18 DO  Q
  1.  ;. .I +$G(^DPT(DFN,"TYPE")) DO
  1.  ;. . .S $P(RESULT,HLFS,18)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
  1.  ;. .E  S $P(RESULT,HLFS,18)=HLQ
  1.  ;.I HLD=44 S $P(PV1,HLFS,44)=$$HLDATE^HLFNC(EVDT) Q
  1.  ;.I HLD=50 S $P(PV1,HLFS,50)=EVENT Q
  1.  ;
  1.  I PSTR[",3," S $P(PV1,HLFS,3)=$$CLINIC(NODE)
  1.  I PSTR[",7," S $P(PV1,HLFS,7)=$$OUTPRO(NODE)
  1.  ;.;patient type for v2.3
  1.  I PSTR[18 DO
  1.  .I +$G(^DPT(DFN,"TYPE")) DO
  1.  . .S $P(PV1,HLFS,18)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
  1.  . .E  S $P(PV1,HLFS,18)=HLQ
  1.  ;
  1.  ; facility and suffix
  1.  ;
  1.  I PSTR[39  D
  1.  . N VAFACSUF,VAMEDCTR,GLOB
  1.  . S GLOB="^"_$P(VPTR,";",2)_+VPTR
  1.  . ;
  1.  . ; If variable pointer is for patient file:
  1.  . I GLOB["DPT(" D
  1.  . . N PATNODE S PATNODE=""
  1.  . . I '$D(^DPT(DFN)) Q
  1.  . . F  S PATNODE=$O(^DPT(DFN,"DIS",PATNODE)) D  Q:PATNODE=""
  1.  . . . N PATDATA,VAFILE
  1.  . . . Q:PATNODE=""
  1.  . . . S PATDATA=$G(^DPT(DFN,"DIS",PATNODE,0))
  1.  . . . ; Spin through multiple events and get division pointer
  1.  . . . I EVDT=$P(PATDATA,"^",1) D  Q:VAFILE="MATCH"
  1.  . . . . S VAMEDCTR=$P(PATDATA,"^",4) I VAMEDCTR="" S VAFILE="" Q
  1.  . . . . ; get facility/suffix from medical center div file
  1.  . . . . S VAFACSUF=$P($G(^DG(40.8,VAMEDCTR,0)),"^",2)
  1.  . . . . ; move data into the PV1 segment
  1.  . . . . S $P(PV1,HLFS,39)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
  1.  . . . . S VAFILE="MATCH",PATNODE=""
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . ; If variable pointer is for outpatient encounter file:
  1.  . I GLOB["^SCE(" D
  1.  . . N VAFIEN,ENCDATA,ENCDATE
  1.  . . ; get encounter date and medical center division
  1.  . . S VAFIEN=+VPTR Q:VAFIEN=""
  1.  . . I '$D(^SCE(VAFIEN)) Q
  1.  . . S ENCDATA=$G(^SCE(VAFIEN,0))
  1.  . . S ENCDATE=$P(ENCDATA,"^",1) Q:ENCDATE=""
  1.  . . S VAMEDCTR=$P(ENCDATA,"^",11) Q:VAMEDCTR=""
  1.  . . ; call below returns: inst pointer^inst name^facility w/suffix
  1.  . . S VAFACSUF=$$SITE^VASITE(ENCDATE,VAMEDCTR)
  1.  . . S VAFACSUF=$P(VAFACSUF,"^",3)
  1.  . . ; move data into the PV1 segment
  1.  . . S $P(PV1,HLFS,39)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
  1.  . . Q
  1.  . ;
  1.  . ; If variable pointer is for patient movement file:
  1.  . I GLOB["^DGPM(" D
  1.  . . N VAFIEN,VAFDATE,VAWARD
  1.  . . ; get movement date and medical center division
  1.  . . S VAFIEN=+VPTR Q:VAFIEN=""
  1.  . . I '$D(^DGPM(VAFIEN)) Q
  1.  . . S VAFDATE=$P($G(^DGPM(VAFIEN,0)),"^",1) Q:VAFDATE=""
  1.  . . S VAWARD=$P($G(^DGPM(VAFIEN,0)),"^",6) Q:VAWARD=""
  1.  . . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
  1.  . . ; call below returns: inst pointer^inst name^facility w/suffix
  1.  . . S VAFACSUF=$$SITE^VASITE(VAFDATE,VAMEDCTR)
  1.  . . S VAFACSUF=$P(VAFACSUF,"^",3)
  1.  . . ; move data into the PV1 segment
  1.  . . S $P(PV1,HLFS,39)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  I PSTR[44 S $P(PV1,HLFS,44)=$$HLDATE^HLFNC(EVDT)
  1.  I PSTR[50 S $P(PV1,HLFS,50)=EVENT
  1.  ;
  1.  I PV1?1"^"."^" Q RESULT
  1.  S $P(PV1,HLFS,1)=PNUM,PV1="PV1"_HLFS_PV1
  1.  K NODE,QUOT
  1.  Q PV1
  1.  ;
  1. CLINIC(ZNODE) ;
  1.  ;Get clinic for appointments and add/edit stop codes
  1.  ;
  1.  N HPTR,HLOC,GLOB,LOC
  1.  ;
  1.  ;HPTR=fifth piece in pivot file - Variable pointer
  1.  ;
  1.  S (HLOC,LOC)="",HPTR=$P(ZNODE,"^",5),GLOB="^"_$P(HPTR,";",2)_+HPTR_")"
  1.  I $E(GLOB,1,5)="^DPT(" D
  1.  .;Patient file, appointment hasn't gotten to outpatient encounter file
  1.  .S HLOC=$P($G(@GLOB@("S",$P(NODE,"^"),0)),"^")
  1.  ;
  1.  I $E(GLOB,1,5)="^SCE(" D
  1.  .N VAENC0
  1.  .;Outpatient Encounter file
  1.  .S HLOC=$$SCE^DGSDU(+$P(GLOB,"^SCE(",2),4,0)
  1.  ;
  1.  I HLOC="" Q QUOT
  1.  ;HLOC is IEN of Hospital Location file
  1.  S LOC=$P($G(^SC(HLOC,0)),"^")
  1.  I LOC="" S LOC=QUOT
  1.  Q LOC
  1.  ;
  1. OUTPRO(ZNODE) ;
  1.  ;
  1.  N OUTPTR,OPRV,OPTR,FILE,PTR
  1.  ;
  1.  ;OUTPTR=fifth piece in pivot file - variable pointer
  1.  ;
  1.  S OUTPTR=$P(ZNODE,"^",5),OPTR=+OUTPTR,FILE=$P(OUTPTR,";",2)
  1.  I OPTR=""!(FILE'="SCE(") Q ""
  1.  ;
  1.  ;get primary provider
  1.  S OPRV=$$GETPRO(OPTR) I OPRV DO  Q OPRV
  1.  . I $P($G(^VA(200,OPRV,0)),"^")]"" DO
  1.  . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=OPRV,DGNAME("FIELD")=.01
  1.  . . S OPRV=OPRV_$E(HLECH)_$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
  1.  . E  S OPRV=QUOT
  1.  ;
  1.  Q QUOT
  1.  ;
  1. GETPRO(OPTR) ;get first primary provider Returns OPRV or 0
  1.  N VAENC0,VAEPRV,VAP
  1.  S VAENC0=$$SCE^DGSDU(OPTR)
  1.  I OPTR,+VAENC0,$$DATE^SCDXUTL(+VAENC0)
  1.  E  Q 0
  1.  ;
  1.  S OPRV=0
  1.  D GETPRV^SDOE(OPTR,"VAEPRV")
  1.  S VAP=0 F  S VAP=$O(VAEPRV(VAP)) Q:'VAP  I $P(VAEPRV(VAP),"^",4)="P" S OPRV=+VAEPRV(VAP)_"^P" Q
  1.  Q +OPRV