IBDFN12 ;ALB/CJM - ENCOUNTER FORM - SELECTORS;MAY 10, 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,40**;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
D LOOKUP(81,"I '$P(^(0),U,4)",.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
D LOOKUP(80,"I '$P(^(0),U,9)",.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
D LOOKUP(357.69,"I '$P(^(0),U,4)",.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
IBDFN12 ;ALB/CJM - ENCOUNTER FORM - SELECTORS;MAY 10, 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,40**;APR 24, 1997
+2 ;
LOOKUP(FILE,SCREEN,X,NODE) ;
+1 ; -- lookup X in file using SCREEN
+2 ; -- kills X if lookup not successful, else sets X to the ien and returns NODE as the 0 node
+3 ; -- pass X and NODE by reference
+4 ;
+5 IF +$GET(FILE)<1
KILL X
QUIT
+6 NEW Y
+7 SET (NODE,Y)=""
+8 KILL DIC
SET DIC=FILE
SET DIC("S")=SCREEN
+9 SET DIC(0)="EMQZ"
+10 IF $DATA(^DIC(FILE))
DO ^DIC
KILL DIC
+11 IF +Y>0
Begin DoDot:1
+12 SET X=Y
SET NODE=Y(0)
End DoDot:1
+13 IF '$TEST
KILL X
+14 QUIT
+15 ;
SLCTCPT(X) ;for CPT codes
+1 ;pass X by reference
+2 ;example of use: D SLCTCPT^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(81,"I '$P(^(0),U,4)",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^",2)
SET (IBID,X)=$PIECE(NODE,"^",1)
+7 QUIT
+8 ;
SLCTDX(X) ;for ICD9 diagnosis codes
+1 ;pass X by reference
+2 ;example of use: D SLCTICD^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(80,"I '$P(^(0),U,9)",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^",3)
SET (IBID,X)=$PIECE(NODE,"^",1)
+7 QUIT
+8 ;
SLCTVST(X) ;for VISIT TYPE codes
+1 ;pass X by reference
+2 ;example of use: D SLCTVST^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(357.69,"I '$P(^(0),U,4)",.X,.NODE)
+6 ;; --change to api cpt ; dhh
+7 IF $GET(X)
SET NODE=$$CPT^ICPTCOD(+NODE)
SET NODE=$GET(NODE)
SET (IBID,X)=$PIECE(NODE,"^",2)
SET IBLABEL=$PIECE(NODE,"^",3)
+8 QUIT
+9 ;
SLCTED(X) ;for Education Topics
+1 ;pass X by reference
+2 ;example of use: D SLCTED^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(9999999.09,"",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^")
SET IBID=+X
SET X=IBLABEL
+7 QUIT
+8 ;
SLCTIMM(X) ;for Immunizations
+1 ;pass X by reference
+2 ;example of use: D SLCTIMM^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(9999999.14,"",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^",2)
SET IBID=+X
SET X=IBLABEL
+7 QUIT
+8 ;
SLCTEX(X) ;for Exams
+1 ;pass X by reference
+2 ;example of use: D SLCTEX^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(9999999.15,"",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^")
SET IBID=+X
SET X=IBLABEL
+7 QUIT
+8 ;
SLCTSKN(X) ;for Skin Tests
+1 ;pass X by reference
+2 ;example of use: D SLCTSKN^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(9999999.28,"",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^")
SET IBID=+X
SET X=IBLABEL
+7 QUIT
+8 ;
SLCTHF(X) ;for Health Factors
+1 ;pass X by reference
+2 ;example of use: D SLCTHF^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(9999999.64,"I $P(^(0),U,10)=""F"",'$P(^(0),U,11)",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^")
SET IBID=+X
SET X=IBLABEL
+7 QUIT
SLCTTR(X) ;for Treatments
+1 ;pass X by reference
+2 ;example of use: D SLCTTR^IBDFN12(.X)
+3 ;
+4 NEW NODE
+5 DO LOOKUP(9999999.17,"",.X,.NODE)
+6 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^")
SET IBID=+X
SET X=IBLABEL
+7 QUIT
+8 ;
SLCTYN(X) ;for selecting YES or NO
+1 ;
+2 IF "Yy"[$EXTRACT(X)
SET X="YES"
SET IBID=1
QUIT
+3 IF "Nn"[$EXTRACT(X)
SET X="NO"
SET IBID=0
QUIT
+4 WRITE "Enter YES or NO."
+5 KILL X
+6 QUIT
+7 ;
SLCTCLS(PI,X) ;for visit classification
+1 ;pass X by reference
+2 ;*NOTE: if interactive sets IBQUAL to the qualifier, IBLABEL to the recommended label, for use in the input template
+3 ;example of use: D INPUTCLS^IBDFN12(PI,.X)
+4 ;
+5 NEW NODE
+6 DO LOOKUP(357.98,"I $$DQGOOD^IBDFU9(PI,Y)",.X,.NODE)
+7 IF $DATA(X)
SET IBID=""
SET IBLABEL=$PIECE(NODE,"^",3)
SET IBQUAL=+X
SET X=$PIECE(NODE,"^")
+8 QUIT
