- IBDF18E1 ;ALB/CJM - ENCOUNTER FORM - PCE DEVICE INTERFACE utilities ;04-OCT-94
- ;;3.0;AUTOMATED INFO COLLECTION SYS;**1,3,38,36**;APR 24, 1997
- ;
- GETPI(PI,QLFR,TYPE) ; -- returns information about the package interface
- ; needed to map data to PCE DEVICE INTERFACE
- ;
- ; -- input - PI := pointer to the package interface file
- ; MUST be passed by reference
- ; QLFR := pointer to the data qualifier
- ; TYPE := pointer to file 359.1, applies to hand print fields
- ;
- ; -- output PI :="" if the mapping can not be determined
- ; PI(PI,"NODE")
- ; PI(PI,"VAL")
- ; PI(PI,"TXT")
- ; PI(PI,"HDR")
- ; PI(PI,"QLFR")
- ; PI(PI,"QTY")
- ; - if QLFR is passed, also returns PI(PI,QLFR,"IND")
- ; - if PI(PI,QLFR,"IND")=1,meaning there is independent mapping
- ; info for this qualifier - then also returns PI(PI,QLFR,"NODE")=
- ; <the node>,PI(PI,QLFR,"VAL")=<piece for the value>,
- ; PI(PI,QLFR,"TXT")=<the piece for txt>,PI(PI,QLFR,"HDR")=
- ; <piece for the hdr>,
- ; PI(PI,QLFR,"QLFR")=<piece for the qualifier code>
- ; - if TYPE is passed , also returns PI(PI,"TYPE",TYPE,"UNIT")=
- ; <unit code> and PI(PI,"TYPE",TYPE,"VTYPE")=
- ; <vitals type code>
- ;
- ;NOTE - it is assumed that entries in the PI() may be left hanging around,and if so they are valid
- ;
- N NODE,QNODE,PIECE,IEN
- I '$G(PI) S PI="" G GETPIQ
- ;
- ; -- type of package interface must be for input
- I $P($G(^IBE(357.6,PI,0)),"^",6)'=1 S PI="" G GETPIQ
- ;
- I '$D(PI(PI)) D Q:'PI ""
- .S NODE=$G(^IBE(357.6,PI,12))
- .S PI(PI,"NODE")=$P(NODE,"^")
- .S PI(PI,"VAL")=$P(NODE,"^",2)
- .S PI(PI,"TXT")=$P(NODE,"^",3)
- .S PI(PI,"HDR")=$P(NODE,"^",4)
- .S PI(PI,"QLFR")=$P(NODE,"^",5)
- .S PI(PI,"QTY")=$P(NODE,"^",6)
- ;
- ; - if there is a 'PCE DIM PIECE, VARIABLE VALUE' node, execute code to
- ; - determine value for PCE DIM PIECE, VALUE (since it is variable, it
- ; - must be asked outside of the above dotted do
- S X="",Y=VALUE X $G(^IBE(357.6,PI,21)) I X S PI(PI,"VAL")=X
- ;
- ;special rules apply for the VITALS node
- I PI(PI,"NODE")="VITALS" D Q:'PI ""
- .S PI(PI,"VAL")=2 ;the value for the VITALS node goes to piece 2
- .;
- .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
- .;
- .;may have already gotten
- .I $D(PI(PI,"TYPE",TYPE)) Q
- .;
- .S IEN=$O(^IBE(357.6,PI,13,"B",TYPE_";IBE(359.1,",""))
- .I 'IEN D LOGERR^IBDF18E2(3576001,.FORMID,TYPE,$G(VALUE),PI) S PI(PI,"TYPE",TYPE,"VTYPE")="",PI(PI,"TYPE",TYPE,"UNIT")="" Q
- .S NODE=$G(^IBE(359.1,TYPE,0))
- .S PI(PI,"TYPE",TYPE,"UNIT")=$P(NODE,"^",13)
- .S PI(PI,"TYPE",TYPE,"VTYPE")=$P(NODE,"^",12)
- .S PI(PI,"TYPE",TYPE,"DATATYPE")=$P($G(^IBE(359.1,TYPE,10)),"^",1)
- ;
- ;if not VITALS, and there is a QLFR, get independent mapping info if not gotten previously
- I PI(PI,"NODE")'="VITALS",QLFR I '$D(PI(PI,QLFR,"IND")) D Q:'PI ""
- .S PI(PI,QLFR,"CODE")=$P($G(^IBD(357.98,QLFR,0)),"^",2)
- .S IEN=$O(^IBE(357.6,PI,13,"B",QLFR_";IBD(357.98,",""))
- .I 'IEN D LOGERR^IBDF18E2(3576002,.FORMID,$G(TYPE),$G(VALUE),PI,$G(QLFR)) S PI(PI,QLFR,"IND")=0 Q
- .S NODE=$G(^IBE(357.6,PI,13,IEN,0))
- .S PI(PI,QLFR,"IND")=$P(NODE,"^",3)
- .Q:'PI(PI,QLFR,"IND")
- .S QNODE=$P(NODE,"^",4) S:QNODE="" QNODE=PI(PI,"NODE") S PI(PI,QLFR,"NODE")=QNODE
- .S PIECE=$P(NODE,"^",8) S:('PIECE)&(PI(PI,"NODE")=PI(PI,QLFR,"NODE")) PIECE=PI(PI,"QLFR") S PI(PI,QLFR,"QLFR")=PIECE
- .;
- .;if the node isn't different for the qualifier then the value,text,and header can not be mapped independently
- .I PI(PI,"NODE")=PI(PI,QLFR,"NODE") D
- ..S PI(PI,QLFR,"VAL")=PI(PI,"VAL"),PI(PI,QLFR,"TXT")=PI(PI,"TXT"),PI(PI,QLFR,"HDR")=PI(PI,"HDR")
- .E S PI(PI,QLFR,"VAL")=$P(NODE,"^",5),PI(PI,QLFR,"TXT")=$P(NODE,"^",6),PI(PI,QLFR,"HDR")=$P(NODE,"^",7)
- .;must at least know the piece to place the returned value
- .I (PI(PI,QLFR,"NODE")="")!('PI(PI,QLFR,"VAL")) S PI=""
- ;
- ;must at least know the node and the piece to place the returned value
- I 'QLFR I (PI(PI,"NODE")="")!('PI(PI,"VAL")) S PI=""
- GETPIQ Q PI
- ;
- SETTEMP ; -- sets values for the field into TEMP()
- ; values are merged for fields that consist of a collection
- ;
- ; -- Output QCODE := <qualifier code>
- ; PHDR := <header piece>
- ; PVAL := <value piece>
- ; PTXT := <text piece>
- ; PQLFR := <qualifier piece>
- ; SUB := <PCE GDI node>
- ; NODE := <the value of the node>
- ; PLEX := <clinical lexicon piece, for use with diag.>
- ;
- N QCODE,PHDR,PVAL,PTXT,PQLFR,SUB,NODE,PLEX,PQTY,SAVEPI
- S SAVEPI=PI
- Q:'PI
- S PI=$$GETPI(.PI,QLFR,TYPE) I 'PI D LOGERR^IBDF18E2(3576003,.FORMID,$G(TYPE),$G(VALUE),SAVEPI,$G(QLFR)) Q
- ;
- S QCODE=$S(QLFR:PI(PI,QLFR,"CODE"),1:"")
- ;
- ;determine if QCODE should be passed as VALUE
- I $P($G(^IBE(357.6,PI,20)),"^") N VALUE S VALUE=QCODE
- ;
- S PQTY=PI(PI,"QTY")
- ;mapping info could come from several different sources depending on whether or not a data qualifier is involved or the node=VITALS or ENCOUNTER
- I QLFR,PI(PI,"NODE")'="VITALS",PI(PI,"NODE")'="ENCOUNTER" I PI(PI,QLFR,"IND") D
- .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")
- E D
- .S PHDR=PI(PI,"HDR"),PVAL=PI(PI,"VAL"),PTXT=PI(PI,"TXT"),PQLFR=PI(PI,"QLFR"),SUB=PI(PI,"NODE")
- ;
- ;the ENCOUNTER node is treated differently, because there is always just one of them
- S:SUB'="ENCOUNTER" NODE=$G(TEMP(SUB,$P(FID,"("),+ITEM))
- S:SUB="ENCOUNTER" NODE=$G(PXCA("ENCOUNTER"))
- ;
- ; -- define clin lex pointer if from data enty ($d(ibdf(item)))
- ; if from scanning clin lex pointer defined in ibdf18e
- S PLEX=0 I SUB="DIAGNOSIS/PROBLEM" D
- .S PLEX=3
- .I $G(ITEM)'="" I $D(IBDF(ITEM)) S LEX=$P(IBDF(ITEM),"^",5)
- ;
- ;the VITALS node is also treated differently
- I SUB="VITALS" D
- .I $G(PI(PI,"TYPE",TYPE,"DATATYPE"))="f" S VALUE=+VALUE ; set floating point values to M values
- .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"))
- ;these are nodes other than VITALS and ENCOUNTER
- E D
- .;merge the data into the node
- .;
- .; -- for second provider entry put in provider node, always put
- .; primary in encounter node
- .I SUB="ENCOUNTER",PVAL=4,$P(NODE,"^",4) D Q
- ..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
- ..S PXCA("PROVIDER",VALUE)=QCODE Q
- .;
- .S NARR=+$G(NARR) ; define Narr for manual data entry
- .;
- .; -- change to add modifiers to visit code selected
- .;
- .I $P(NODE,"^",PVAL)="" D
- .. S:$S(NARR=0:1,1:$P(FID,"(",2)'="N") $P(NODE,"^",PVAL)=VALUE
- .. ;D MODTEMP
- .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
- .I PHDR I $L($P(NODE,"^",PHDR))<$L(HEADER) S $P(NODE,"^",PHDR)=HEADER
- .I PQTY S $P(NODE,"^",PQTY)=$G(QUANTITY)
- .;
- .; -- insert clin lex pointer into temp arry and re-initialize
- .I $G(PLEX),$G(LEX) S $P(NODE,"^",PLEX)=LEX
- .S LEX=0
- .;
- .I QCODE'="" S $P(NODE,"^",PQLFR)=$S($P(NODE,"^",PQLFR)'="":$P(NODE,"^",PQLFR)_","_QCODE,1:QCODE)
- ;
- ;- Prevent 'No classification' node from being set in TEMP array
- ;- (not dynamic)
- S:SUB'="ENCOUNTER"&(SUB'="IBD NOCLASSIFICATION") TEMP(SUB,$P(FID,"("),+ITEM)=NODE
- D:SUB="PROCEDURE" MODTEMP
- ;
- ;- Set Encounter and 'No classification' nodes into PXCA array
- S:SUB="ENCOUNTER"!(SUB="IBD NOCLASSIFICATION") PXCA(SUB)=NODE
- D:SUB="ENCOUNTER" MODTEMP
- Q
- MODTEMP ;-- Set up TEMP(SUB,$P(FID,"("),+ITEM, "MODIFIER array
- ; the CPT Modifier information is stored in the selection file(357.3)
- ;
- ;
- N MCOUNT,MOD
- I $D(^IBE(357.3,+$G(SLCTN),3)) D
- . S MCOUNT=0
- . F MOD=0:0 S MOD=$O(^IBE(357.3,SLCTN,3,MOD)) Q:'MOD D
- .. S MCOUNT=MCOUNT+1
- ..S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",MCOUNT)=$P($G(^IBE(357.3,SLCTN,3,MOD,0)),"^")
- .S:MCOUNT>0 TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
- I $D(IBDF(+ITEM,"MODIFIER")) D
- . S MCOUNT=+$G(TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0))
- . S MOD=0 F S MOD=$O(IBDF(+ITEM,"MODIFIER",MOD)) Q:'MOD D
- .. S MCOUNT=MCOUNT+1
- .. S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",MCOUNT)=IBDF(+ITEM,"MODIFIER",MOD)
- . S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF18E1 8539 printed Jan 18, 2025@03:52:08 Page 2
- 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
- +2 ;
- GETPI(PI,QLFR,TYPE) ; -- returns information about the package interface
- +1 ; needed to map data to PCE DEVICE INTERFACE
- +2 ;
- +3 ; -- input - PI := pointer to the package interface file
- +4 ; MUST be passed by reference
- +5 ; QLFR := pointer to the data qualifier
- +6 ; TYPE := pointer to file 359.1, applies to hand print fields
- +7 ;
- +8 ; -- output PI :="" if the mapping can not be determined
- +9 ; PI(PI,"NODE")
- +10 ; PI(PI,"VAL")
- +11 ; PI(PI,"TXT")
- +12 ; PI(PI,"HDR")
- +13 ; PI(PI,"QLFR")
- +14 ; PI(PI,"QTY")
- +15 ; - if QLFR is passed, also returns PI(PI,QLFR,"IND")
- +16 ; - if PI(PI,QLFR,"IND")=1,meaning there is independent mapping
- +17 ; info for this qualifier - then also returns PI(PI,QLFR,"NODE")=
- +18 ; <the node>,PI(PI,QLFR,"VAL")=<piece for the value>,
- +19 ; PI(PI,QLFR,"TXT")=<the piece for txt>,PI(PI,QLFR,"HDR")=
- +20 ; <piece for the hdr>,
- +21 ; PI(PI,QLFR,"QLFR")=<piece for the qualifier code>
- +22 ; - if TYPE is passed , also returns PI(PI,"TYPE",TYPE,"UNIT")=
- +23 ; <unit code> and PI(PI,"TYPE",TYPE,"VTYPE")=
- +24 ; <vitals type code>
- +25 ;
- +26 ;NOTE - it is assumed that entries in the PI() may be left hanging around,and if so they are valid
- +27 ;
- +28 NEW NODE,QNODE,PIECE,IEN
- +29 IF '$GET(PI)
- SET PI=""
- GOTO GETPIQ
- +30 ;
- +31 ; -- type of package interface must be for input
- +32 IF $PIECE($GET(^IBE(357.6,PI,0)),"^",6)'=1
- SET PI=""
- GOTO GETPIQ
- +33 ;
- +34 IF '$DATA(PI(PI))
- Begin DoDot:1
- +35 SET NODE=$GET(^IBE(357.6,PI,12))
- +36 SET PI(PI,"NODE")=$PIECE(NODE,"^")
- +37 SET PI(PI,"VAL")=$PIECE(NODE,"^",2)
- +38 SET PI(PI,"TXT")=$PIECE(NODE,"^",3)
- +39 SET PI(PI,"HDR")=$PIECE(NODE,"^",4)
- +40 SET PI(PI,"QLFR")=$PIECE(NODE,"^",5)
- +41 SET PI(PI,"QTY")=$PIECE(NODE,"^",6)
- End DoDot:1
- if 'PI
- QUIT ""
- +42 ;
- +43 ; - if there is a 'PCE DIM PIECE, VARIABLE VALUE' node, execute code to
- +44 ; - determine value for PCE DIM PIECE, VALUE (since it is variable, it
- +45 ; - must be asked outside of the above dotted do
- +46 SET X=""
- SET Y=VALUE
- XECUTE $GET(^IBE(357.6,PI,21))
- IF X
- SET PI(PI,"VAL")=X
- +47 ;
- +48 ;special rules apply for the VITALS node
- +49 IF PI(PI,"NODE")="VITALS"
- Begin DoDot:1
- +50 ;the value for the VITALS node goes to piece 2
- SET PI(PI,"VAL")=2
- +51 ;
- +52 IF 'TYPE
- DO LOGERR^IBDF18E2(35791001,.FORMID,TYPE,$GET(VALUE),PI)
- SET PI(PI,"TYPE",+$GET(TYPE),"VTYPE")=""
- SET PI(PI,"TYPE",+$GET(TYPE),"UNIT")=""
- QUIT
- +53 ;
- +54 ;may have already gotten
- +55 IF $DATA(PI(PI,"TYPE",TYPE))
- QUIT
- +56 ;
- +57 SET IEN=$ORDER(^IBE(357.6,PI,13,"B",TYPE_";IBE(359.1,",""))
- +58 IF 'IEN
- DO LOGERR^IBDF18E2(3576001,.FORMID,TYPE,$GET(VALUE),PI)
- SET PI(PI,"TYPE",TYPE,"VTYPE")=""
- SET PI(PI,"TYPE",TYPE,"UNIT")=""
- QUIT
- +59 SET NODE=$GET(^IBE(359.1,TYPE,0))
- +60 SET PI(PI,"TYPE",TYPE,"UNIT")=$PIECE(NODE,"^",13)
- +61 SET PI(PI,"TYPE",TYPE,"VTYPE")=$PIECE(NODE,"^",12)
- +62 SET PI(PI,"TYPE",TYPE,"DATATYPE")=$PIECE($GET(^IBE(359.1,TYPE,10)),"^",1)
- End DoDot:1
- if 'PI
- QUIT ""
- +63 ;
- +64 ;if not VITALS, and there is a QLFR, get independent mapping info if not gotten previously
- +65 IF PI(PI,"NODE")'="VITALS"
- IF QLFR
- IF '$DATA(PI(PI,QLFR,"IND"))
- Begin DoDot:1
- +66 SET PI(PI,QLFR,"CODE")=$PIECE($GET(^IBD(357.98,QLFR,0)),"^",2)
- +67 SET IEN=$ORDER(^IBE(357.6,PI,13,"B",QLFR_";IBD(357.98,",""))
- +68 IF 'IEN
- DO LOGERR^IBDF18E2(3576002,.FORMID,$GET(TYPE),$GET(VALUE),PI,$GET(QLFR))
- SET PI(PI,QLFR,"IND")=0
- QUIT
- +69 SET NODE=$GET(^IBE(357.6,PI,13,IEN,0))
- +70 SET PI(PI,QLFR,"IND")=$PIECE(NODE,"^",3)
- +71 if 'PI(PI,QLFR,"IND")
- QUIT
- +72 SET QNODE=$PIECE(NODE,"^",4)
- if QNODE=""
- SET QNODE=PI(PI,"NODE")
- SET PI(PI,QLFR,"NODE")=QNODE
- +73 SET PIECE=$PIECE(NODE,"^",8)
- if ('PIECE)&(PI(PI,"NODE")=PI(PI,QLFR,"NODE"))
- SET PIECE=PI(PI,"QLFR")
- SET PI(PI,QLFR,"QLFR")=PIECE
- +74 ;
- +75 ;if the node isn't different for the qualifier then the value,text,and header can not be mapped independently
- +76 IF PI(PI,"NODE")=PI(PI,QLFR,"NODE")
- Begin DoDot:2
- +77 SET PI(PI,QLFR,"VAL")=PI(PI,"VAL")
- SET PI(PI,QLFR,"TXT")=PI(PI,"TXT")
- SET PI(PI,QLFR,"HDR")=PI(PI,"HDR")
- End DoDot:2
- +78 IF '$TEST
- SET PI(PI,QLFR,"VAL")=$PIECE(NODE,"^",5)
- SET PI(PI,QLFR,"TXT")=$PIECE(NODE,"^",6)
- SET PI(PI,QLFR,"HDR")=$PIECE(NODE,"^",7)
- +79 ;must at least know the piece to place the returned value
- +80 IF (PI(PI,QLFR,"NODE")="")!('PI(PI,QLFR,"VAL"))
- SET PI=""
- End DoDot:1
- if 'PI
- QUIT ""
- +81 ;
- +82 ;must at least know the node and the piece to place the returned value
- +83 IF 'QLFR
- IF (PI(PI,"NODE")="")!('PI(PI,"VAL"))
- SET PI=""
- GETPIQ QUIT PI
- +1 ;
- SETTEMP ; -- sets values for the field into TEMP()
- +1 ; values are merged for fields that consist of a collection
- +2 ;
- +3 ; -- Output QCODE := <qualifier code>
- +4 ; PHDR := <header piece>
- +5 ; PVAL := <value piece>
- +6 ; PTXT := <text piece>
- +7 ; PQLFR := <qualifier piece>
- +8 ; SUB := <PCE GDI node>
- +9 ; NODE := <the value of the node>
- +10 ; PLEX := <clinical lexicon piece, for use with diag.>
- +11 ;
- +12 NEW QCODE,PHDR,PVAL,PTXT,PQLFR,SUB,NODE,PLEX,PQTY,SAVEPI
- +13 SET SAVEPI=PI
- +14 if 'PI
- QUIT
- +15 SET PI=$$GETPI(.PI,QLFR,TYPE)
- IF 'PI
- DO LOGERR^IBDF18E2(3576003,.FORMID,$GET(TYPE),$GET(VALUE),SAVEPI,$GET(QLFR))
- QUIT
- +16 ;
- +17 SET QCODE=$SELECT(QLFR:PI(PI,QLFR,"CODE"),1:"")
- +18 ;
- +19 ;determine if QCODE should be passed as VALUE
- +20 IF $PIECE($GET(^IBE(357.6,PI,20)),"^")
- NEW VALUE
- SET VALUE=QCODE
- +21 ;
- +22 SET PQTY=PI(PI,"QTY")
- +23 ;mapping info could come from several different sources depending on whether or not a data qualifier is involved or the node=VITALS or ENCOUNTER
- +24 IF QLFR
- IF PI(PI,"NODE")'="VITALS"
- IF PI(PI,"NODE")'="ENCOUNTER"
- IF PI(PI,QLFR,"IND")
- Begin DoDot:1
- +25 SET PHDR=PI(PI,QLFR,"HDR")
- SET PVAL=PI(PI,QLFR,"VAL")
- SET PTXT=PI(PI,QLFR,"TXT")
- SET PQLFR=PI(PI,QLFR,"QLFR")
- SET SUB=PI(PI,QLFR,"NODE")
- End DoDot:1
- +26 IF '$TEST
- Begin DoDot:1
- +27 SET PHDR=PI(PI,"HDR")
- SET PVAL=PI(PI,"VAL")
- SET PTXT=PI(PI,"TXT")
- SET PQLFR=PI(PI,"QLFR")
- SET SUB=PI(PI,"NODE")
- End DoDot:1
- +28 ;
- +29 ;the ENCOUNTER node is treated differently, because there is always just one of them
- +30 if SUB'="ENCOUNTER"
- SET NODE=$GET(TEMP(SUB,$PIECE(FID,"("),+ITEM))
- +31 if SUB="ENCOUNTER"
- SET NODE=$GET(PXCA("ENCOUNTER"))
- +32 ;
- +33 ; -- define clin lex pointer if from data enty ($d(ibdf(item)))
- +34 ; if from scanning clin lex pointer defined in ibdf18e
- +35 SET PLEX=0
- IF SUB="DIAGNOSIS/PROBLEM"
- Begin DoDot:1
- +36 SET PLEX=3
- +37 IF $GET(ITEM)'=""
- IF $DATA(IBDF(ITEM))
- SET LEX=$PIECE(IBDF(ITEM),"^",5)
- End DoDot:1
- +38 ;
- +39 ;the VITALS node is also treated differently
- +40 IF SUB="VITALS"
- Begin DoDot:1
- +41 ; set floating point values to M values
- IF $GET(PI(PI,"TYPE",TYPE,"DATATYPE"))="f"
- SET VALUE=+VALUE
- +42 SET $PIECE(NODE,"^")=PI(PI,"TYPE",TYPE,"VTYPE")
- SET $PIECE(NODE,"^",3)=PI(PI,"TYPE",TYPE,"UNIT")
- SET $PIECE(NODE,"^",2)=VALUE
- SET $PIECE(NODE,"^",4)=+$GET(PXCA("ENCOUNTER"))
- End DoDot:1
- +43 ;these are nodes other than VITALS and ENCOUNTER
- +44 IF '$TEST
- Begin DoDot:1
- +45 ;merge the data into the node
- +46 ;
- +47 ; -- for second provider entry put in provider node, always put
- +48 ; primary in encounter node
- +49 IF SUB="ENCOUNTER"
- IF PVAL=4
- IF $PIECE(NODE,"^",4)
- Begin DoDot:2
- +50 IF QCODE="P"
- IF $PIECE(NODE,"^",15)'="P"
- SET PXCA("PROVIDER",$PIECE(NODE,"^",4))=$PIECE(NODE,"^",15)
- SET $PIECE(NODE,"^",4)=VALUE
- SET $PIECE(NODE,"^",15)=QCODE
- QUIT
- +51 SET PXCA("PROVIDER",VALUE)=QCODE
- QUIT
- End DoDot:2
- QUIT
- +52 ;
- +53 ; define Narr for manual data entry
- SET NARR=+$GET(NARR)
- +54 ;
- +55 ; -- change to add modifiers to visit code selected
- +56 ;
- +57 IF $PIECE(NODE,"^",PVAL)=""
- Begin DoDot:2
- +58 if $SELECT(NARR=0
- SET $PIECE(NODE,"^",PVAL)=VALUE
- +59 ;D MODTEMP
- End DoDot:2
- +60 IF PTXT
- if $PIECE(FID,"(",2)="N"&NARR
- SET TEXT=VALUE
- IF $SELECT(NARR=0:$LENGTH($PIECE(NODE,"^",PTXT))<$LENGTH(TEXT),$PIECE(FID,"(",2)="N":TEXT'="",1:0)
- SET $PIECE(NODE,"^",PTXT)=TEXT
- +61 IF PHDR
- IF $LENGTH($PIECE(NODE,"^",PHDR))<$LENGTH(HEADER)
- SET $PIECE(NODE,"^",PHDR)=HEADER
- +62 IF PQTY
- SET $PIECE(NODE,"^",PQTY)=$GET(QUANTITY)
- +63 ;
- +64 ; -- insert clin lex pointer into temp arry and re-initialize
- +65 IF $GET(PLEX)
- IF $GET(LEX)
- SET $PIECE(NODE,"^",PLEX)=LEX
- +66 SET LEX=0
- +67 ;
- +68 IF QCODE'=""
- SET $PIECE(NODE,"^",PQLFR)=$SELECT($PIECE(NODE,"^",PQLFR)'="":$PIECE(NODE,"^",PQLFR)_","_QCODE,1:QCODE)
- End DoDot:1
- +69 ;
- +70 ;- Prevent 'No classification' node from being set in TEMP array
- +71 ;- (not dynamic)
- +72 if SUB'="ENCOUNTER"&(SUB'="IBD NOCLASSIFICATION")
- SET TEMP(SUB,$PIECE(FID,"("),+ITEM)=NODE
- +73 if SUB="PROCEDURE"
- DO MODTEMP
- +74 ;
- +75 ;- Set Encounter and 'No classification' nodes into PXCA array
- +76 if SUB="ENCOUNTER"!(SUB="IBD NOCLASSIFICATION")
- SET PXCA(SUB)=NODE
- +77 if SUB="ENCOUNTER"
- DO MODTEMP
- +78 QUIT
- MODTEMP ;-- Set up TEMP(SUB,$P(FID,"("),+ITEM, "MODIFIER array
- +1 ; the CPT Modifier information is stored in the selection file(357.3)
- +2 ;
- +3 ;
- +4 NEW MCOUNT,MOD
- +5 IF $DATA(^IBE(357.3,+$GET(SLCTN),3))
- Begin DoDot:1
- +6 SET MCOUNT=0
- +7 FOR MOD=0:0
- SET MOD=$ORDER(^IBE(357.3,SLCTN,3,MOD))
- if 'MOD
- QUIT
- Begin DoDot:2
- +8 SET MCOUNT=MCOUNT+1
- +9 SET TEMP(SUB,$PIECE(FID,"("),+ITEM,"MODIFIER",MCOUNT)=$PIECE($GET(^IBE(357.3,SLCTN,3,MOD,0)),"^")
- End DoDot:2
- +10 if MCOUNT>0
- SET TEMP(SUB,$PIECE(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
- End DoDot:1
- +11 IF $DATA(IBDF(+ITEM,"MODIFIER"))
- Begin DoDot:1
- +12 SET MCOUNT=+$GET(TEMP(SUB,$PIECE(FID,"("),+ITEM,"MODIFIER",0))
- +13 SET MOD=0
- FOR
- SET MOD=$ORDER(IBDF(+ITEM,"MODIFIER",MOD))
- if 'MOD
- QUIT
- Begin DoDot:2
- +14 SET MCOUNT=MCOUNT+1
- +15 SET TEMP(SUB,$PIECE(FID,"("),+ITEM,"MODIFIER",MCOUNT)=IBDF(+ITEM,"MODIFIER",MOD)
- End DoDot:2
- +16 SET TEMP(SUB,$PIECE(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
- End DoDot:1
- +17 QUIT