- 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 Feb 19, 2025@00:19:17 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