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

IBDFN12.m

Go to the documentation of this file.
  1. IBDFN12 ;ALB/CJM - ENCOUNTER FORM - SELECTORS ;05/10/95
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,40,51,63**;APR 24, 1997;Build 80
  1. ;
  1. ;
  1. LOOKUP(FILE,SCREEN,X,NODE) ;
  1. ; -- lookup X in file using SCREEN
  1. ; -- kills X if lookup not successful, else sets X to the ien and returns NODE as the 0 node
  1. ; -- pass X and NODE by reference
  1. ;
  1. I +$G(FILE)<1 K X Q
  1. N Y
  1. S (NODE,Y)=""
  1. K DIC S DIC=FILE,DIC("S")=SCREEN
  1. S DIC(0)="EMQZ"
  1. I $D(^DIC(FILE)) D ^DIC K DIC
  1. I +Y>0 D
  1. .S X=Y,NODE=Y(0)
  1. E K X
  1. Q
  1. ;
  1. SLCTCPT(X) ;for CPT codes
  1. ;pass X by reference
  1. ;example of use: D SLCTCPT^IBDFN12(.X)
  1. ;
  1. N NODE,SCRN
  1. ;;D LOOKUP(81,"I '$P(^(0),U,4)",.X,.NODE)
  1. ;
  1. ;List only active code. (CSV)
  1. S SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;Check status for CPT (CSV)
  1. D LOOKUP(81,SCRN,.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^",2),(IBID,X)=$P(NODE,"^",1)
  1. Q
  1. ;
  1. SLCTDX10(X) ;
  1. ;Get ICD-10 code.
  1. N IBDCODE
  1. I $G(X)="" K X Q
  1. I X["?" D INPHLP^IBDLXDG K X Q
  1. D SETPARAM^IBDLXDG(.IBDPARAM)
  1. S IBDCODE=$$LEXICD10^IBDLXDG(X,$$ICD10DT^IBDUTICD(DT),.IBDPARAM)
  1. I IBDCODE="" W !!,IBDPARAM("NO DATA FOUND"),!,IBDPARAM("NO DATA FOUND 2"),! K X Q
  1. I IBDCODE=-1!(IBDCODE=-2)!(IBDCODE=-3)!(IBDCODE=-4) K X Q ;Timed out or was aborted.
  1. S X=$P($P(IBDCODE,U),";",2)
  1. ;
  1. Q
  1. SLCTDX(X) ;for ICD9 diagnosis codes
  1. ;pass X by reference
  1. ;example of use: D SLCTICD^IBDFN12(.X)
  1. ;
  1. N NODE,SCRN
  1. ;;D LOOKUP(80,"I '$P(^(0),U,9)",.X,.NODE)
  1. ;
  1. ;List only active code. (CSV)
  1. S SCRN="I $P($$ICDDX^ICDCODE(Y),U,10)=1" ;Check status for ICD (CSV)
  1. D LOOKUP(80,SCRN,.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^",3),(IBID,X)=$P(NODE,"^",1)
  1. Q
  1. ;
  1. SLCTVST(X) ;for VISIT TYPE codes
  1. ;pass X by reference
  1. ;example of use: D SLCTVST^IBDFN12(.X)
  1. ;
  1. N NODE,SCREEN
  1. ;;D LOOKUP(357.69,"I '$P(^(0),U,4)",.X,.NODE)
  1. ;
  1. ;List only active code. (CSV)
  1. S SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;Check status for CPT (CSV)
  1. D LOOKUP(357.69,SCRN,.X,.NODE)
  1. ;
  1. ;; --change to api cpt ; dhh
  1. I $G(X) S NODE=$$CPT^ICPTCOD(+NODE),NODE=$G(NODE),(IBID,X)=$P(NODE,"^",2),IBLABEL=$P(NODE,"^",3)
  1. Q
  1. ;
  1. SLCTED(X) ;for Education Topics
  1. ;pass X by reference
  1. ;example of use: D SLCTED^IBDFN12(.X)
  1. ;
  1. N NODE
  1. D LOOKUP(9999999.09,"",.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
  1. Q
  1. ;
  1. SLCTIMM(X) ;for Immunizations
  1. ;pass X by reference
  1. ;example of use: D SLCTIMM^IBDFN12(.X)
  1. ;
  1. N NODE
  1. D LOOKUP(9999999.14,"",.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^",2),IBID=+X,X=IBLABEL
  1. Q
  1. ;
  1. SLCTEX(X) ;for Exams
  1. ;pass X by reference
  1. ;example of use: D SLCTEX^IBDFN12(.X)
  1. ;
  1. N NODE
  1. D LOOKUP(9999999.15,"",.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
  1. Q
  1. ;
  1. SLCTSKN(X) ;for Skin Tests
  1. ;pass X by reference
  1. ;example of use: D SLCTSKN^IBDFN12(.X)
  1. ;
  1. N NODE
  1. D LOOKUP(9999999.28,"",.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
  1. Q
  1. ;
  1. SLCTHF(X) ;for Health Factors
  1. ;pass X by reference
  1. ;example of use: D SLCTHF^IBDFN12(.X)
  1. ;
  1. N NODE
  1. D LOOKUP(9999999.64,"I $P(^(0),U,10)=""F"",'$P(^(0),U,11)",.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
  1. Q
  1. SLCTTR(X) ;for Treatments
  1. ;pass X by reference
  1. ;example of use: D SLCTTR^IBDFN12(.X)
  1. ;
  1. N NODE
  1. D LOOKUP(9999999.17,"",.X,.NODE)
  1. I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
  1. Q
  1. ;
  1. SLCTYN(X) ;for selecting YES or NO
  1. ;
  1. I "Yy"[$E(X) S X="YES",IBID=1 Q
  1. I "Nn"[$E(X) S X="NO",IBID=0 Q
  1. W "Enter YES or NO."
  1. K X
  1. Q
  1. ;
  1. SLCTCLS(PI,X) ;for visit classification
  1. ;pass X by reference
  1. ;*NOTE: if interactive sets IBQUAL to the qualifier, IBLABEL to the recommended label, for use in the input template
  1. ;example of use: D INPUTCLS^IBDFN12(PI,.X)
  1. ;
  1. N NODE
  1. D LOOKUP(357.98,"I $$DQGOOD^IBDFU9(PI,Y)",.X,.NODE)
  1. I $D(X) S IBID="",IBLABEL=$P(NODE,"^",3),IBQUAL=+X,X=$P(NODE,"^")
  1. Q