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

IBDF18E1.m

Go to the documentation of this file.
  1. IBDF18E1 ;ALB/CJM - ENCOUNTER FORM - PCE DEVICE INTERFACE utilities ;04-OCT-94
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**1,3,38,36**;APR 24, 1997
  1. ;
  1. GETPI(PI,QLFR,TYPE) ; -- returns information about the package interface
  1. ; needed to map data to PCE DEVICE INTERFACE
  1. ;
  1. ; -- input - PI := pointer to the package interface file
  1. ; MUST be passed by reference
  1. ; QLFR := pointer to the data qualifier
  1. ; TYPE := pointer to file 359.1, applies to hand print fields
  1. ;
  1. ; -- output PI :="" if the mapping can not be determined
  1. ; PI(PI,"NODE")
  1. ; PI(PI,"VAL")
  1. ; PI(PI,"TXT")
  1. ; PI(PI,"HDR")
  1. ; PI(PI,"QLFR")
  1. ; PI(PI,"QTY")
  1. ; - if QLFR is passed, also returns PI(PI,QLFR,"IND")
  1. ; - if PI(PI,QLFR,"IND")=1,meaning there is independent mapping
  1. ; info for this qualifier - then also returns PI(PI,QLFR,"NODE")=
  1. ; <the node>,PI(PI,QLFR,"VAL")=<piece for the value>,
  1. ; PI(PI,QLFR,"TXT")=<the piece for txt>,PI(PI,QLFR,"HDR")=
  1. ; <piece for the hdr>,
  1. ; PI(PI,QLFR,"QLFR")=<piece for the qualifier code>
  1. ; - if TYPE is passed , also returns PI(PI,"TYPE",TYPE,"UNIT")=
  1. ; <unit code> and PI(PI,"TYPE",TYPE,"VTYPE")=
  1. ; <vitals type code>
  1. ;
  1. ;NOTE - it is assumed that entries in the PI() may be left hanging around,and if so they are valid
  1. ;
  1. N NODE,QNODE,PIECE,IEN
  1. I '$G(PI) S PI="" G GETPIQ
  1. ;
  1. ; -- type of package interface must be for input
  1. I $P($G(^IBE(357.6,PI,0)),"^",6)'=1 S PI="" G GETPIQ
  1. ;
  1. I '$D(PI(PI)) D Q:'PI ""
  1. .S NODE=$G(^IBE(357.6,PI,12))
  1. .S PI(PI,"NODE")=$P(NODE,"^")
  1. .S PI(PI,"VAL")=$P(NODE,"^",2)
  1. .S PI(PI,"TXT")=$P(NODE,"^",3)
  1. .S PI(PI,"HDR")=$P(NODE,"^",4)
  1. .S PI(PI,"QLFR")=$P(NODE,"^",5)
  1. .S PI(PI,"QTY")=$P(NODE,"^",6)
  1. ;
  1. ; - if there is a 'PCE DIM PIECE, VARIABLE VALUE' node, execute code to
  1. ; - determine value for PCE DIM PIECE, VALUE (since it is variable, it
  1. ; - must be asked outside of the above dotted do
  1. S X="",Y=VALUE X $G(^IBE(357.6,PI,21)) I X S PI(PI,"VAL")=X
  1. ;
  1. ;special rules apply for the VITALS node
  1. I PI(PI,"NODE")="VITALS" D Q:'PI ""
  1. .S PI(PI,"VAL")=2 ;the value for the VITALS node goes to piece 2
  1. .;
  1. .I 'TYPE D LOGERR^IBDF18E2(35791001,.FORMID,TYPE,$G(VALUE),PI) S PI(PI,"TYPE",+$G(TYPE),"VTYPE")="",PI(PI,"TYPE",+$G(TYPE),"UNIT")="" Q
  1. .;
  1. .;may have already gotten
  1. .I $D(PI(PI,"TYPE",TYPE)) Q
  1. .;
  1. .S IEN=$O(^IBE(357.6,PI,13,"B",TYPE_";IBE(359.1,",""))
  1. .I 'IEN D LOGERR^IBDF18E2(3576001,.FORMID,TYPE,$G(VALUE),PI) S PI(PI,"TYPE",TYPE,"VTYPE")="",PI(PI,"TYPE",TYPE,"UNIT")="" Q
  1. .S NODE=$G(^IBE(359.1,TYPE,0))
  1. .S PI(PI,"TYPE",TYPE,"UNIT")=$P(NODE,"^",13)
  1. .S PI(PI,"TYPE",TYPE,"VTYPE")=$P(NODE,"^",12)
  1. .S PI(PI,"TYPE",TYPE,"DATATYPE")=$P($G(^IBE(359.1,TYPE,10)),"^",1)
  1. ;
  1. ;if not VITALS, and there is a QLFR, get independent mapping info if not gotten previously
  1. I PI(PI,"NODE")'="VITALS",QLFR I '$D(PI(PI,QLFR,"IND")) D Q:'PI ""
  1. .S PI(PI,QLFR,"CODE")=$P($G(^IBD(357.98,QLFR,0)),"^",2)
  1. .S IEN=$O(^IBE(357.6,PI,13,"B",QLFR_";IBD(357.98,",""))
  1. .I 'IEN D LOGERR^IBDF18E2(3576002,.FORMID,$G(TYPE),$G(VALUE),PI,$G(QLFR)) S PI(PI,QLFR,"IND")=0 Q
  1. .S NODE=$G(^IBE(357.6,PI,13,IEN,0))
  1. .S PI(PI,QLFR,"IND")=$P(NODE,"^",3)
  1. .Q:'PI(PI,QLFR,"IND")
  1. .S QNODE=$P(NODE,"^",4) S:QNODE="" QNODE=PI(PI,"NODE") S PI(PI,QLFR,"NODE")=QNODE
  1. .S PIECE=$P(NODE,"^",8) S:('PIECE)&(PI(PI,"NODE")=PI(PI,QLFR,"NODE")) PIECE=PI(PI,"QLFR") S PI(PI,QLFR,"QLFR")=PIECE
  1. .;
  1. .;if the node isn't different for the qualifier then the value,text,and header can not be mapped independently
  1. .I PI(PI,"NODE")=PI(PI,QLFR,"NODE") D
  1. ..S PI(PI,QLFR,"VAL")=PI(PI,"VAL"),PI(PI,QLFR,"TXT")=PI(PI,"TXT"),PI(PI,QLFR,"HDR")=PI(PI,"HDR")
  1. .E S PI(PI,QLFR,"VAL")=$P(NODE,"^",5),PI(PI,QLFR,"TXT")=$P(NODE,"^",6),PI(PI,QLFR,"HDR")=$P(NODE,"^",7)
  1. .;must at least know the piece to place the returned value
  1. .I (PI(PI,QLFR,"NODE")="")!('PI(PI,QLFR,"VAL")) S PI=""
  1. ;
  1. ;must at least know the node and the piece to place the returned value
  1. I 'QLFR I (PI(PI,"NODE")="")!('PI(PI,"VAL")) S PI=""
  1. GETPIQ Q PI
  1. ;
  1. SETTEMP ; -- sets values for the field into TEMP()
  1. ; values are merged for fields that consist of a collection
  1. ;
  1. ; -- Output QCODE := <qualifier code>
  1. ; PHDR := <header piece>
  1. ; PVAL := <value piece>
  1. ; PTXT := <text piece>
  1. ; PQLFR := <qualifier piece>
  1. ; SUB := <PCE GDI node>
  1. ; NODE := <the value of the node>
  1. ; PLEX := <clinical lexicon piece, for use with diag.>
  1. ;
  1. N QCODE,PHDR,PVAL,PTXT,PQLFR,SUB,NODE,PLEX,PQTY,SAVEPI
  1. S SAVEPI=PI
  1. Q:'PI
  1. S PI=$$GETPI(.PI,QLFR,TYPE) I 'PI D LOGERR^IBDF18E2(3576003,.FORMID,$G(TYPE),$G(VALUE),SAVEPI,$G(QLFR)) Q
  1. ;
  1. S QCODE=$S(QLFR:PI(PI,QLFR,"CODE"),1:"")
  1. ;
  1. ;determine if QCODE should be passed as VALUE
  1. I $P($G(^IBE(357.6,PI,20)),"^") N VALUE S VALUE=QCODE
  1. ;
  1. S PQTY=PI(PI,"QTY")
  1. ;mapping info could come from several different sources depending on whether or not a data qualifier is involved or the node=VITALS or ENCOUNTER
  1. I QLFR,PI(PI,"NODE")'="VITALS",PI(PI,"NODE")'="ENCOUNTER" I PI(PI,QLFR,"IND") D
  1. .S PHDR=PI(PI,QLFR,"HDR"),PVAL=PI(PI,QLFR,"VAL"),PTXT=PI(PI,QLFR,"TXT"),PQLFR=PI(PI,QLFR,"QLFR"),SUB=PI(PI,QLFR,"NODE")
  1. E D
  1. .S PHDR=PI(PI,"HDR"),PVAL=PI(PI,"VAL"),PTXT=PI(PI,"TXT"),PQLFR=PI(PI,"QLFR"),SUB=PI(PI,"NODE")
  1. ;
  1. ;the ENCOUNTER node is treated differently, because there is always just one of them
  1. S:SUB'="ENCOUNTER" NODE=$G(TEMP(SUB,$P(FID,"("),+ITEM))
  1. S:SUB="ENCOUNTER" NODE=$G(PXCA("ENCOUNTER"))
  1. ;
  1. ; -- define clin lex pointer if from data enty ($d(ibdf(item)))
  1. ; if from scanning clin lex pointer defined in ibdf18e
  1. S PLEX=0 I SUB="DIAGNOSIS/PROBLEM" D
  1. .S PLEX=3
  1. .I $G(ITEM)'="" I $D(IBDF(ITEM)) S LEX=$P(IBDF(ITEM),"^",5)
  1. ;
  1. ;the VITALS node is also treated differently
  1. I SUB="VITALS" D
  1. .I $G(PI(PI,"TYPE",TYPE,"DATATYPE"))="f" S VALUE=+VALUE ; set floating point values to M values
  1. .S $P(NODE,"^")=PI(PI,"TYPE",TYPE,"VTYPE"),$P(NODE,"^",3)=PI(PI,"TYPE",TYPE,"UNIT"),$P(NODE,"^",2)=VALUE,$P(NODE,"^",4)=+$G(PXCA("ENCOUNTER"))
  1. ;these are nodes other than VITALS and ENCOUNTER
  1. E D
  1. .;merge the data into the node
  1. .;
  1. .; -- for second provider entry put in provider node, always put
  1. .; primary in encounter node
  1. .I SUB="ENCOUNTER",PVAL=4,$P(NODE,"^",4) D Q
  1. ..I QCODE="P",$P(NODE,"^",15)'="P" S PXCA("PROVIDER",$P(NODE,"^",4))=$P(NODE,"^",15),$P(NODE,"^",4)=VALUE,$P(NODE,"^",15)=QCODE Q
  1. ..S PXCA("PROVIDER",VALUE)=QCODE Q
  1. .;
  1. .S NARR=+$G(NARR) ; define Narr for manual data entry
  1. .;
  1. .; -- change to add modifiers to visit code selected
  1. .;
  1. .I $P(NODE,"^",PVAL)="" D
  1. .. S:$S(NARR=0:1,1:$P(FID,"(",2)'="N") $P(NODE,"^",PVAL)=VALUE
  1. .. ;D MODTEMP
  1. .I PTXT S:$P(FID,"(",2)="N"&NARR TEXT=VALUE I $S(NARR=0:$L($P(NODE,"^",PTXT))<$L(TEXT),$P(FID,"(",2)="N":TEXT'="",1:0) S $P(NODE,"^",PTXT)=TEXT
  1. .I PHDR I $L($P(NODE,"^",PHDR))<$L(HEADER) S $P(NODE,"^",PHDR)=HEADER
  1. .I PQTY S $P(NODE,"^",PQTY)=$G(QUANTITY)
  1. .;
  1. .; -- insert clin lex pointer into temp arry and re-initialize
  1. .I $G(PLEX),$G(LEX) S $P(NODE,"^",PLEX)=LEX
  1. .S LEX=0
  1. .;
  1. .I QCODE'="" S $P(NODE,"^",PQLFR)=$S($P(NODE,"^",PQLFR)'="":$P(NODE,"^",PQLFR)_","_QCODE,1:QCODE)
  1. ;
  1. ;- Prevent 'No classification' node from being set in TEMP array
  1. ;- (not dynamic)
  1. S:SUB'="ENCOUNTER"&(SUB'="IBD NOCLASSIFICATION") TEMP(SUB,$P(FID,"("),+ITEM)=NODE
  1. D:SUB="PROCEDURE" MODTEMP
  1. ;
  1. ;- Set Encounter and 'No classification' nodes into PXCA array
  1. S:SUB="ENCOUNTER"!(SUB="IBD NOCLASSIFICATION") PXCA(SUB)=NODE
  1. D:SUB="ENCOUNTER" MODTEMP
  1. Q
  1. MODTEMP ;-- Set up TEMP(SUB,$P(FID,"("),+ITEM, "MODIFIER array
  1. ; the CPT Modifier information is stored in the selection file(357.3)
  1. ;
  1. ;
  1. N MCOUNT,MOD
  1. I $D(^IBE(357.3,+$G(SLCTN),3)) D
  1. . S MCOUNT=0
  1. . F MOD=0:0 S MOD=$O(^IBE(357.3,SLCTN,3,MOD)) Q:'MOD D
  1. .. S MCOUNT=MCOUNT+1
  1. ..S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",MCOUNT)=$P($G(^IBE(357.3,SLCTN,3,MOD,0)),"^")
  1. .S:MCOUNT>0 TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
  1. I $D(IBDF(+ITEM,"MODIFIER")) D
  1. . S MCOUNT=+$G(TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0))
  1. . S MOD=0 F S MOD=$O(IBDF(+ITEM,"MODIFIER",MOD)) Q:'MOD D
  1. .. S MCOUNT=MCOUNT+1
  1. .. S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",MCOUNT)=IBDF(+ITEM,"MODIFIER",MOD)
  1. . S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
  1. Q