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;JAN 4, 1996
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38**;APR 24, 1997
  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.  S (IBID,IBLABEL,IBINACT)=""
  1.  I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
  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(^(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(^(0),"^"),IBINACT=$P(^(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(^(0),"^"),IBINACT=$P(^(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(^(0),"^"),IBINACT=$P(^(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(^(0),"^"),IBINACT=$P(^(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(^(0),"^"),IBINACT=$P(^(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(^(0),"^"),IBINACT=$P(^(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