source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN12.m@ 1800

IBDFN12 ;ALB/CJM - ENCOUNTER FORM - SELECTORS;MAY 10, 1995

 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,40,51**;APR 24, 1997

 ;

LOOKUP(FILE,SCREEN,X,NODE) ;

 ; -- lookup X in file using SCREEN

 ; -- kills X if lookup not successful, else sets X to the ien and returns NODE as the 0 node

 ; -- pass X and NODE by reference

 ;

 I +$G(FILE)<1 K X Q

 N Y

 S (NODE,Y)=""

 K DIC S DIC=FILE,DIC("S")=SCREEN

 S DIC(0)="EMQZ"

 I $D(^DIC(FILE)) D ^DIC K DIC

 I +Y>0 D

 .S X=Y,NODE=Y(0)

 E  K X

 Q

 ;

SLCTCPT(X) ;for CPT codes

 ;pass X by reference

 ;example of use: D SLCTCPT^IBDFN12(.X)

 ;

 N NODE,SCRN

 ;;D LOOKUP(81,"I '$P(^(0),U,4)",.X,.NODE)

 ;

 ;List only active code. (CSV)

 S SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;Check status for CPT (CSV)

 D LOOKUP(81,SCRN,.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^",2),(IBID,X)=$P(NODE,"^",1)

 Q

 ;

SLCTDX(X) ;for ICD9 diagnosis codes

 ;pass X by reference

 ;example of use: D SLCTICD^IBDFN12(.X)

 ;

 N NODE,SCRN

 ;;D LOOKUP(80,"I '$P(^(0),U,9)",.X,.NODE)

 ;

 ;List only active code. (CSV)

 S SCRN="I $P($$ICDDX^ICDCODE(Y),U,10)=1" ;Check status for ICD (CSV)

 D LOOKUP(80,SCRN,.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^",3),(IBID,X)=$P(NODE,"^",1)

 Q

 ;

SLCTVST(X) ;for VISIT TYPE codes

 ;pass X by reference

 ;example of use: D SLCTVST^IBDFN12(.X)

 ;

 N NODE,SCREEN

 ;;D LOOKUP(357.69,"I '$P(^(0),U,4)",.X,.NODE)

 ;

 ;List only active code. (CSV)

 S SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;Check status for CPT (CSV)

 D LOOKUP(357.69,SCRN,.X,.NODE)

 ;

 ;; --change to api cpt ; dhh

 I $G(X) S NODE=$$CPT^ICPTCOD(+NODE),NODE=$G(NODE),(IBID,X)=$P(NODE,"^",2),IBLABEL=$P(NODE,"^",3)

 Q

 ;

SLCTED(X) ;for Education Topics

 ;pass X by reference

 ;example of use: D SLCTED^IBDFN12(.X)

 ;

 N NODE

 D LOOKUP(9999999.09,"",.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL

 Q

 ;

SLCTIMM(X) ;for Immunizations

 ;pass X by reference

 ;example of use: D SLCTIMM^IBDFN12(.X)

 ;

 N NODE

 D LOOKUP(9999999.14,"",.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^",2),IBID=+X,X=IBLABEL

 Q

 ;

SLCTEX(X) ;for Exams

 ;pass X by reference

 ;example of use: D SLCTEX^IBDFN12(.X)

 ;

 N NODE

 D LOOKUP(9999999.15,"",.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL

 Q

 ;

SLCTSKN(X) ;for Skin Tests

 ;pass X by reference

 ;example of use: D SLCTSKN^IBDFN12(.X)

 ;

 N NODE

 D LOOKUP(9999999.28,"",.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL

 Q

 ;

SLCTHF(X) ;for Health Factors

 ;pass X by reference

 ;example of use: D SLCTHF^IBDFN12(.X)

 ;

 N NODE

 D LOOKUP(9999999.64,"I $P(^(0),U,10)=""F"",'$P(^(0),U,11)",.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL

 Q

SLCTTR(X) ;for Treatments

 ;pass X by reference

 ;example of use: D SLCTTR^IBDFN12(.X)

 ;

 N NODE

 D LOOKUP(9999999.17,"",.X,.NODE)

 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL

 Q

 ;

SLCTYN(X) ;for selecting YES or NO

 ;

 I "Yy"[$E(X) S X="YES",IBID=1 Q

 I "Nn"[$E(X) S X="NO",IBID=0 Q

 W "Enter YES or NO."

 K X

 Q

 ;

SLCTCLS(PI,X) ;for visit classification

 ;pass X by reference

 ;*NOTE: if interactive sets IBQUAL to the qualifier, IBLABEL to the recommended label, for use in the input template

 ;example of use: D INPUTCLS^IBDFN12(PI,.X)

 ;

 N NODE

 D LOOKUP(357.98,"I $$DQGOOD^IBDFU9(PI,Y)",.X,.NODE)

 I $D(X) S IBID="",IBLABEL=$P(NODE,"^",3),IBQUAL=+X,X=$P(NODE,"^")

 Q