IBDFN14 ;ALB/CMR - ENCOUNTER FORM - OUTPUTS;JAN 4, 1996
;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38**;APR 24, 1997
;
CPT(X) ; -- return external value, descr and active flag for CPT code
; -- X passed equal to ien for cpt code
;
; input: ien of file #81
; output: IBID = cpt code (.01 field of file #81)
; IBLABEL = description fo cpt code
; IBINACT = null if active
; 1 if inactive
;
Q:'X
N IBDFNODE
S (IBID,IBLABEL,IBINACT)=""
S IBDFNODE=$$CPT^ICPTCOD(X)
Q:+IBDFNODE=-1
S IBID=$P(IBDFNODE,"^",2)
S IBLABEL=$P(IBDFNODE,"^",3)
S IBINACT=$S($P(IBDFNODE,"^",7)=1:"",1:1)
Q
DX(X) ; -- return external value, descr and active flag for ICD9 diagnosis
; -- pass X equal to ien for icd9 code
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
Q
VST(X) ; -- return external value, descr and active flag for VISIT TYPE
; -- pass X equal to ien for visit type
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
;; --change to api cpt ; dhh
I $G(^IBE(357.69,X,0))]"",+$$CPT^ICPTCOD(X)'=-1 D
.S IBID=$P(^IBE(357.69,X,0),"^"),IBLABEL=$P(^(0),"^",3)
.S HDR=$P(^IBE(357.69,X,0),"^",2) I $L(HDR_IBLABEL)<75 S IBLABEL=HDR_" "_IBLABEL
.K HDR
.;; --change to api cpt ; dhh
.S IBINACT=$S($P(^IBE(357.69,X,0),"^",4):1,$P($$CPT^ICPTCOD(X),"^",7)=0:1,1:"")
Q
ED(X) ; -- return descr and active flag for education topics
; -- pass X equal to ien for education topic
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^AUTTEDT(X,0))]"" S IBID="ED TOPIC",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",3)
Q
EXAM(X) ; -- return descr and active flag for exam
; -- pass X equal to ien for exam
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^AUTTEXAM(X,0))]"" S IBID="EXAM",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",4)
Q
HF(X) ; -- return descr and active flag for health factor
; -- pass X equal to ien for health factor
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^AUTTHF(X,0))]"" S IBID="FACTOR",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",11)
Q
;
IMMUN(X) ; -- return descr and active flag for immunization
; -- pass X equal to ien for immunization
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^AUTTIMM(X,0))]"" S IBID="IMMUN",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",7)
Q
;
TREAT(X) ; -- return descr and active flag for treatment
; -- pass X equal to ien for TREATMENTS
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^AUTTTRT(X,0))]"" S IBID="TREATMENT",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",4)
Q
;
ST(X) ; -- return descr and active flag for immunization
; -- pass X equal to ien for immunization
;
Q:'X
S (IBID,IBLABEL,IBINACT)=""
I $G(^AUTTSK(X,0))]"" S IBID="SKIN TEST",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",3)
Q
YN(X) ; -- return descr
; -- pass X equal to 1 or 0
;
Q:X']""
S IBID="VALUE"
S (IBLABEL,IBINACT)=""
I X S IBLABEL="YES" Q
S IBLABEL="NO" Q
Q
IBDFN14 ;ALB/CMR - ENCOUNTER FORM - OUTPUTS;JAN 4, 1996
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38**;APR 24, 1997
+2 ;
CPT(X) ; -- return external value, descr and active flag for CPT code
+1 ; -- X passed equal to ien for cpt code
+2 ;
+3 ; input: ien of file #81
+4 ; output: IBID = cpt code (.01 field of file #81)
+5 ; IBLABEL = description fo cpt code
+6 ; IBINACT = null if active
+7 ; 1 if inactive
+8 ;
+9 IF 'X
QUIT
+10 NEW IBDFNODE
+11 SET (IBID,IBLABEL,IBINACT)=""
+12 SET IBDFNODE=$$CPT^ICPTCOD(X)
+13 IF +IBDFNODE=-1
QUIT
+14 SET IBID=$PIECE(IBDFNODE,"^",2)
+15 SET IBLABEL=$PIECE(IBDFNODE,"^",3)
+16 SET IBINACT=$SELECT($PIECE(IBDFNODE,"^",7)=1:"",1:1)
+17 QUIT
DX(X) ; -- return external value, descr and active flag for ICD9 diagnosis
+1 ; -- pass X equal to ien for icd9 code
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^ICD9(X,0))]""
SET IBID=$PIECE(^(0),"^")
SET IBLABEL=$PIECE(^(0),"^",3)
SET IBINACT=$PIECE(^(0),"^",9)
+6 QUIT
VST(X) ; -- return external value, descr and active flag for VISIT TYPE
+1 ; -- pass X equal to ien for visit type
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 ;; --change to api cpt ; dhh
+6 IF $GET(^IBE(357.69,X,0))]""
IF +$$CPT^ICPTCOD(X)'=-1
Begin DoDot:1
+7 SET IBID=$PIECE(^IBE(357.69,X,0),"^")
SET IBLABEL=$PIECE(^(0),"^",3)
+8 SET HDR=$PIECE(^IBE(357.69,X,0),"^",2)
IF $LENGTH(HDR_IBLABEL)<75
SET IBLABEL=HDR_" "_IBLABEL
+9 KILL HDR
+10 ;; --change to api cpt ; dhh
+11 SET IBINACT=$SELECT($PIECE(^IBE(357.69,X,0),"^",4):1,$PIECE($$CPT^ICPTCOD(X),"^",7)=0:1,1:"")
End DoDot:1
+12 QUIT
ED(X) ; -- return descr and active flag for education topics
+1 ; -- pass X equal to ien for education topic
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^AUTTEDT(X,0))]""
SET IBID="ED TOPIC"
SET IBLABEL=$PIECE(^(0),"^")
SET IBINACT=$PIECE(^(0),"^",3)
+6 QUIT
EXAM(X) ; -- return descr and active flag for exam
+1 ; -- pass X equal to ien for exam
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^AUTTEXAM(X,0))]""
SET IBID="EXAM"
SET IBLABEL=$PIECE(^(0),"^")
SET IBINACT=$PIECE(^(0),"^",4)
+6 QUIT
HF(X) ; -- return descr and active flag for health factor
+1 ; -- pass X equal to ien for health factor
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^AUTTHF(X,0))]""
SET IBID="FACTOR"
SET IBLABEL=$PIECE(^(0),"^")
SET IBINACT=$PIECE(^(0),"^",11)
+6 QUIT
+7 ;
IMMUN(X) ; -- return descr and active flag for immunization
+1 ; -- pass X equal to ien for immunization
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^AUTTIMM(X,0))]""
SET IBID="IMMUN"
SET IBLABEL=$PIECE(^(0),"^")
SET IBINACT=$PIECE(^(0),"^",7)
+6 QUIT
+7 ;
TREAT(X) ; -- return descr and active flag for treatment
+1 ; -- pass X equal to ien for TREATMENTS
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^AUTTTRT(X,0))]""
SET IBID="TREATMENT"
SET IBLABEL=$PIECE(^(0),"^")
SET IBINACT=$PIECE(^(0),"^",4)
+6 QUIT
+7 ;
ST(X) ; -- return descr and active flag for immunization
+1 ; -- pass X equal to ien for immunization
+2 ;
+3 IF 'X
QUIT
+4 SET (IBID,IBLABEL,IBINACT)=""
+5 IF $GET(^AUTTSK(X,0))]""
SET IBID="SKIN TEST"
SET IBLABEL=$PIECE(^(0),"^")
SET IBINACT=$PIECE(^(0),"^",3)
+6 QUIT
YN(X) ; -- return descr
+1 ; -- pass X equal to 1 or 0
+2 ;
+3 IF X']""
QUIT
+4 SET IBID="VALUE"
+5 SET (IBLABEL,IBINACT)=""
+6 IF X
SET IBLABEL="YES"
QUIT
+7 SET IBLABEL="NO"
QUIT
+8 QUIT
