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

IBDFN14.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. CPT(X) ; -- return external value, descr and active flag for CPT code
  1. ; -- X passed equal to ien for cpt code
  1. ;
  1. ; input: ien of file #81
  1. ; output: IBID = cpt code (.01 field of file #81)
  1. ; IBLABEL = description fo cpt code
  1. ; IBINACT = null if active
  1. ; 1 if inactive
  1. ;
  1. Q:'X
  1. N IBDFNODE
  1. S (IBID,IBLABEL,IBINACT)=""
  1. S IBDFNODE=$$CPT^ICPTCOD(X)
  1. Q:+IBDFNODE=-1
  1. S IBID=$P(IBDFNODE,"^",2)
  1. S IBLABEL=$P(IBDFNODE,"^",3)
  1. S IBINACT=$S($P(IBDFNODE,"^",7)=1:"",1:1)
  1. Q
  1. DX(X) ; -- return external value, descr and active flag for ICD9 diagnosis
  1. ; -- pass X equal to ien for icd9 code
  1. ;
  1. Q:'X
  1. N ICDNODE,IBDSTAT
  1. S (IBID,IBLABEL,IBINACT)=""
  1. ;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
  1. S ICDNODE=$$ICDDX^ICDCODE(X)
  1. Q:+ICDNODE=-1
  1. S IBID=$P(ICDNODE,U,2) ;ICD code
  1. S IBLABEL=$P(ICDNODE,U,4) ;ICD description
  1. S IBDSTAT=$P(ICDNODE,U,10) ;ICD status, 0-Not Active, 1-Acitve
  1. ;
  1. ;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
  1. I IBDSTAT=0 S IBINACT=1
  1. Q
  1. DX10(X) ; -- return external value, descr and active flag for ICD-10 diagnosis
  1. ; -- pass X equal to ien for ICD-10 code
  1. ;
  1. Q:'X
  1. N ICDNODE,IBDSTAT
  1. S (IBID,IBLABEL,IBINACT)=""
  1. ;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
  1. S ICDNODE=$$ICDDATA^ICDXCODE("10D",X,DT)
  1. Q:+ICDNODE<1
  1. S IBID=$P(ICDNODE,U,2) ;ICD code
  1. S IBLABEL=$P(ICDNODE,U,4) ;ICD description
  1. S IBDSTAT=$P(ICDNODE,U,10) ;ICD status, 0-Not Active, 1-Acitve
  1. ;
  1. ;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
  1. I IBDSTAT=0 S IBINACT=1
  1. Q
  1. VST(X) ; -- return external value, descr and active flag for VISIT TYPE
  1. ; -- pass X equal to ien for visit type
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. ;; --change to api cpt ; dhh
  1. I $G(^IBE(357.69,X,0))]"",+$$CPT^ICPTCOD(X)'=-1 D
  1. .S IBID=$P(^IBE(357.69,X,0),"^"),IBLABEL=$P(^IBE(357.69,X,0),"^",3)
  1. .S HDR=$P(^IBE(357.69,X,0),"^",2) I $L(HDR_IBLABEL)<75 S IBLABEL=HDR_" "_IBLABEL
  1. .K HDR
  1. .;; --change to api cpt ; dhh
  1. .S IBINACT=$S($P(^IBE(357.69,X,0),"^",4):1,$P($$CPT^ICPTCOD(X),"^",7)=0:1,1:"")
  1. Q
  1. ED(X) ; -- return descr and active flag for education topics
  1. ; -- pass X equal to ien for education topic
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. I $G(^AUTTEDT(X,0))]"" S IBID="ED TOPIC",IBLABEL=$P(^AUTTEDT(X,0),"^"),IBINACT=$P(^AUTTEDT(X,0),"^",3)
  1. Q
  1. EXAM(X) ; -- return descr and active flag for exam
  1. ; -- pass X equal to ien for exam
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. I $G(^AUTTEXAM(X,0))]"" S IBID="EXAM",IBLABEL=$P(^AUTTEXAM(X,0),"^"),IBINACT=$P(^AUTTEXAM(X,0),"^",4)
  1. Q
  1. HF(X) ; -- return descr and active flag for health factor
  1. ; -- pass X equal to ien for health factor
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. I $G(^AUTTHF(X,0))]"" S IBID="FACTOR",IBLABEL=$P(^AUTTHF(X,0),"^"),IBINACT=$P(^AUTTHF(X,0),"^",11)
  1. Q
  1. ;
  1. IMMUN(X) ; -- return descr and active flag for immunization
  1. ; -- pass X equal to ien for immunization
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. I $G(^AUTTIMM(X,0))]"" S IBID="IMMUN",IBLABEL=$P(^AUTTIMM(X,0),"^"),IBINACT=$P(^AUTTIMM(X,0),"^",7)
  1. Q
  1. ;
  1. TREAT(X) ; -- return descr and active flag for treatment
  1. ; -- pass X equal to ien for TREATMENTS
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. I $G(^AUTTTRT(X,0))]"" S IBID="TREATMENT",IBLABEL=$P(^AUTTTRT(X,0),"^"),IBINACT=$P(^AUTTTRT(X,0),"^",4)
  1. Q
  1. ;
  1. ST(X) ; -- return descr and active flag for immunization
  1. ; -- pass X equal to ien for immunization
  1. ;
  1. Q:'X
  1. S (IBID,IBLABEL,IBINACT)=""
  1. I $G(^AUTTSK(X,0))]"" S IBID="SKIN TEST",IBLABEL=$P(^AUTTSK(X,0),"^"),IBINACT=$P(^AUTTSK(X,0),"^",3)
  1. Q
  1. YN(X) ; -- return descr
  1. ; -- pass X equal to 1 or 0
  1. ;
  1. Q:X']""
  1. S IBID="VALUE"
  1. S (IBLABEL,IBINACT)=""
  1. I X S IBLABEL="YES" Q
  1. S IBLABEL="NO" Q
  1. Q