IBDFN14 ;ALB/CMR - ENCOUNTER FORM - OUTPUTS ;01/04/96
;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,51,63**;APR 24, 1997;Build 80
;
;
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
N ICDNODE,IBDSTAT
S (IBID,IBLABEL,IBINACT)=""
;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
S ICDNODE=$$ICDDX^ICDCODE(X)
Q:+ICDNODE=-1
S IBID=$P(ICDNODE,U,2) ;ICD code
S IBLABEL=$P(ICDNODE,U,4) ;ICD description
S IBDSTAT=$P(ICDNODE,U,10) ;ICD status, 0-Not Active, 1-Acitve
;
;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
I IBDSTAT=0 S IBINACT=1
Q
DX10(X) ; -- return external value, descr and active flag for ICD-10 diagnosis
; -- pass X equal to ien for ICD-10 code
;
Q:'X
N ICDNODE,IBDSTAT
S (IBID,IBLABEL,IBINACT)=""
;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
S ICDNODE=$$ICDDATA^ICDXCODE("10D",X,DT)
Q:+ICDNODE<1
S IBID=$P(ICDNODE,U,2) ;ICD code
S IBLABEL=$P(ICDNODE,U,4) ;ICD description
S IBDSTAT=$P(ICDNODE,U,10) ;ICD status, 0-Not Active, 1-Acitve
;
;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
I IBDSTAT=0 S IBINACT=1
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(^IBE(357.69,X,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(^AUTTEDT(X,0),"^"),IBINACT=$P(^AUTTEDT(X,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(^AUTTEXAM(X,0),"^"),IBINACT=$P(^AUTTEXAM(X,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(^AUTTHF(X,0),"^"),IBINACT=$P(^AUTTHF(X,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(^AUTTIMM(X,0),"^"),IBINACT=$P(^AUTTIMM(X,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(^AUTTTRT(X,0),"^"),IBINACT=$P(^AUTTTRT(X,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(^AUTTSK(X,0),"^"),IBINACT=$P(^AUTTSK(X,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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN14 4019 printed Oct 16, 2024@18:53:37 Page 2
IBDFN14 ;ALB/CMR - ENCOUNTER FORM - OUTPUTS ;01/04/96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,51,63**;APR 24, 1997;Build 80
+2 ;
+3 ;
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 NEW ICDNODE,IBDSTAT
+5 SET (IBID,IBLABEL,IBINACT)=""
+6 ;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
+7 SET ICDNODE=$$ICDDX^ICDCODE(X)
+8 if +ICDNODE=-1
QUIT
+9 ;ICD code
SET IBID=$PIECE(ICDNODE,U,2)
+10 ;ICD description
SET IBLABEL=$PIECE(ICDNODE,U,4)
+11 ;ICD status, 0-Not Active, 1-Acitve
SET IBDSTAT=$PIECE(ICDNODE,U,10)
+12 ;
+13 ;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
+14 IF IBDSTAT=0
SET IBINACT=1
+15 QUIT
DX10(X) ; -- return external value, descr and active flag for ICD-10 diagnosis
+1 ; -- pass X equal to ien for ICD-10 code
+2 ;
+3 if 'X
QUIT
+4 NEW ICDNODE,IBDSTAT
+5 SET (IBID,IBLABEL,IBINACT)=""
+6 ;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
+7 SET ICDNODE=$$ICDDATA^ICDXCODE("10D",X,DT)
+8 if +ICDNODE<1
QUIT
+9 ;ICD code
SET IBID=$PIECE(ICDNODE,U,2)
+10 ;ICD description
SET IBLABEL=$PIECE(ICDNODE,U,4)
+11 ;ICD status, 0-Not Active, 1-Acitve
SET IBDSTAT=$PIECE(ICDNODE,U,10)
+12 ;
+13 ;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
+14 IF IBDSTAT=0
SET IBINACT=1
+15 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(^IBE(357.69,X,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(^AUTTEDT(X,0),"^")
SET IBINACT=$PIECE(^AUTTEDT(X,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(^AUTTEXAM(X,0),"^")
SET IBINACT=$PIECE(^AUTTEXAM(X,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(^AUTTHF(X,0),"^")
SET IBINACT=$PIECE(^AUTTHF(X,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(^AUTTIMM(X,0),"^")
SET IBINACT=$PIECE(^AUTTIMM(X,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(^AUTTTRT(X,0),"^")
SET IBINACT=$PIECE(^AUTTTRT(X,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(^AUTTSK(X,0),"^")
SET IBINACT=$PIECE(^AUTTSK(X,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
