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

VAFHLPR1.m

Go to the documentation of this file. 
  1. VAFHLPR1 ;ALB/ESD - Create generic HL7 PR1 Segment ;4/4/00
  1.  ;;5.3;Registration;**94,123,160,215,243,606,1015**;Aug 13, 1993;Build 21
  1.  ;06/22/99 ACS - Added CPT modifier API calls and added CPT modifier to the
  1.  ;PR1 segment (sequence 16)
  1.  ;
  1.  ;  This function will create VA-specific PR1 segment(s) for a 
  1.  ;  given outpatient encounter. The PR1 segment is designed to transfer
  1.  ;  information relative to various types of procedures performed during
  1.  ;  a patient visit.
  1.  ;
  1. EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFHLECH,VAFARRY) ; Entry point for Ambulatory Care Database Project
  1.  ; - Entry point to return the HL7 PR1 segment
  1.  ;
  1.  ;  Input:   VAFENC - IEN of the Outpatient Encounter (#409.68) file
  1.  ;           VAFSTR - String of fields requested separated by commas
  1.  ;           VAFHLQ - Optional HL7 null variable. If not there, use 
  1.  ;                    default HL7 variable
  1.  ;          VAFHLFS - Optional HL7 field separator. If not there, use 
  1.  ;                    default HL7 variable
  1.  ;         VAFHLECH - HL7 variable containing encoding characters
  1.  ;          VAFARRY - Optional user-supplied array name which will hold PR1 segments
  1.  ;
  1.  ; Output: Array of HL7 PR1 segments
  1.  ;
  1.  ;
  1.  N I,J,VAFCPT,VAFIDX,VAFPR,VAFPROC,VAFPRTYP,VAFY,X,PTRVCPT,PROCCNT,PROCLOOP,ICPTVDT
  1.  S (J,VAFIDX)=0
  1.  S VAFARRY=$G(VAFARRY),ICPTVDT=$$SCE^DGSDU(VAFENC,1,0)
  1.  ;
  1.  ; - Variable ICPTVDT gets correct CPT/Modifier descriptor for event date
  1.  ;
  1.  ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"PROCEDURE")
  1.  S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""PROCEDURE"")"
  1.  ;
  1.  ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables
  1.  S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
  1.  I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,J)="PR1"_VAFHLFS_1 G ENQ
  1.  S VAFSTR=","_VAFSTR_","
  1.  ;
  1.  ; - Get procedures for encounter
  1.  D GETCPT^SDOE(VAFENC,"VAFPROC")
  1.  ;
  1.  ; - Set procedure array to 0 if no procedures to loop thru once
  1.  I '$G(VAFPROC) S VAFPROC(1)=0
  1.  ;
  1. ALL ; - All procedures for encounter
  1.  S PTRVCPT=0
  1.  F  S PTRVCPT=+$O(VAFPROC(PTRVCPT)) Q:('PTRVCPT)  D
  1.  .;S VAFPR=$G(^ICPT(+$G(VAFPROC(PTRVCPT)),0))
  1.  .N CPTINFO
  1.  .S CPTINFO=$$CPT^ICPTCOD(+$G(VAFPROC(PTRVCPT)),,1)
  1.  .Q:CPTINFO'>0
  1.  .S VAFPR=$P(CPTINFO,"^",2,99)
  1.  .S:($P(VAFPR,"^",1)="") $P(VAFPR,"^",1)=VAFHLQ
  1.  .S:($P(VAFPR,"^",2)="") $P(VAFPR,"^",2)=VAFHLQ
  1.  .;
  1.  .; - Build array of HL7 (PR1) segments
  1.  .;   Repeated procedures get individual segment
  1.  .S PROCCNT=+$P($G(VAFPROC(PTRVCPT)),"^",16)
  1.  .S:('PROCCNT) PROCCNT=1
  1.  .F PROCLOOP=1:1:PROCCNT D BUILD
  1.  ;
  1. ENQ Q
  1.  ;
  1.  ;
  1. BUILD ; - Build array of HL7 (PR1) segments
  1.  S J=0,VAFIDX=VAFIDX+1,VAFY=""
  1.  S VAFCPT="C4" ; Procedure Coding Method = C4 (CPT-4)
  1.  ;
  1.  ; - Build HL7 (PR1) segment fields
  1.  ;
  1.  ; - Sequential number (required field)
  1.  S $P(VAFY,VAFHLFS,1)=VAFIDX
  1.  ;
  1.  I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFCPT)]"":VAFCPT,1:VAFHLQ) ; Procedure Coding Method = CPT-4
  1.  I (VAFSTR[",3,") D
  1.  .;Procedure Code
  1.  .S X=$P(VAFPR,"^",1)
  1.  .;Procedure Description
  1.  .S $P(X,$E(VAFHLECH,1),2)=$P(VAFPR,"^",2)
  1.  .;Procedure Coding Method
  1.  .S $P(X,$E(VAFHLECH,1),3)=VAFCPT
  1.  .;Add to segment
  1.  .S $P(VAFY,VAFHLFS,3)=X
  1.  I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$P(VAFPR,"^",2) ; Procedure Description
  1.  ;
  1.  ;  *** Add CPT modifiers to sequence 16 ***
  1.  ;  VAFY    = PR1 segment
  1.  ;  MAXLEN  = maximum length of the segment
  1.  ;  WRAPCNT = continuation segment count (currently 0)
  1.  ;  FSFLAG  = field separator flag: 1="^", 0="|"
  1.  ;  MODIND  = indicates if a modifier has been added to the segment
  1.  ;
  1.  N MAXLEN,WRAPCNT,FSFLAG,MODIND
  1.  S MAXLEN=245,WRAPCNT=0,FSFLAG=1,MODIND=0
  1.  ;
  1.  ;- set up VAFY to have 15 sequences, then concatenate "PR1"
  1.  ;  onto front of segment for a total of 16 sequences
  1.  S $P(VAFY,VAFHLFS,15)=""
  1.  S VAFY="PR1"_VAFHLFS_VAFY
  1.  ;
  1.  ;check if modifiers are requested
  1.  I VAFSTR'[",16," G NOMODS
  1.  ;
  1.  ;- spin through CPT array VAFPROC and retrieve modifiers
  1.  ;- set MODIND flag to 1 if modifiers found
  1.  N PTR,MODPTR,MODINFO,MODCODE,MODTEXT,MODMETH,MODSEQ,SEGLEN
  1.  S PTR=0
  1.  F  S PTR=+$O(VAFPROC(PTRVCPT,1,PTR)) Q:'PTR  D
  1.  . S MODPTR=$G(VAFPROC(PTRVCPT,1,PTR,0))
  1.  . Q:'MODPTR
  1.  . S MODIND=1
  1.  . ;
  1.  . ;- get modifier and coding method
  1.  . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
  1.  . Q:MODINFO'>0
  1.  . S MODCODE=$P(MODINFO,"^",2)
  1.  . S MODTEXT=""
  1.  . S MODMETH=$P(MODINFO,"^",5)
  1.  . ;
  1.  . ;- get correct field separator and build sequence
  1.  . S MODSEQ=$S(FSFLAG:VAFHLFS,1:$E(VAFHLECH,2))_MODCODE
  1.  . S MODSEQ=MODSEQ_$E(VAFHLECH,1)_MODTEXT
  1.  . S MODSEQ=MODSEQ_$E(VAFHLECH,1)_MODMETH
  1.  . S FSFLAG=0
  1.  . ;
  1.  . ;- check length of VAFY segment
  1.  . S SEGLEN=$L(VAFY)+$L(MODSEQ)
  1.  . I SEGLEN>MAXLEN G DONE
  1.  . S VAFY=VAFY_MODSEQ
  1.  . Q
  1.  ;
  1.  ;- --Done spinning through the modifiers--
  1.  ;- if modifiers were added to the segment, write out the
  1.  ;  last modifier
  1. DONE S:MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY
  1.  ;
  1.  ;- if no modifiers were added to the segment, write segment with
  1.  ;  field separator as an empty place holder
  1. NOMODS S:'MODIND @VAFARRY@(VAFIDX,WRAPCNT)=VAFY_VAFHLFS
  1.  Q