IBDFN12 ;ALB/CJM - ENCOUNTER FORM - SELECTORS ;05/10/95
;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,40,51,63**;APR 24, 1997;Build 80
;
;
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
;
SLCTDX10(X) ;
;Get ICD-10 code.
N IBDCODE
I $G(X)="" K X Q
I X["?" D INPHLP^IBDLXDG K X Q
D SETPARAM^IBDLXDG(.IBDPARAM)
S IBDCODE=$$LEXICD10^IBDLXDG(X,$$ICD10DT^IBDUTICD(DT),.IBDPARAM)
I IBDCODE="" W !!,IBDPARAM("NO DATA FOUND"),!,IBDPARAM("NO DATA FOUND 2"),! K X Q
I IBDCODE=-1!(IBDCODE=-2)!(IBDCODE=-3)!(IBDCODE=-4) K X Q ;Timed out or was aborted.
S X=$P($P(IBDCODE,U),";",2)
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN12 3833 printed Apr 09, 2024@21:40:03 Page 2
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
+2 ;
+3 ;
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,SCRN
+5 ;;D LOOKUP(81,"I '$P(^(0),U,4)",.X,.NODE)
+6 ;
+7 ;List only active code. (CSV)
+8 ;Check status for CPT (CSV)
SET SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1"
+9 DO LOOKUP(81,SCRN,.X,.NODE)
+10 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^",2)
SET (IBID,X)=$PIECE(NODE,"^",1)
+11 QUIT
+12 ;
SLCTDX10(X) ;
+1 ;Get ICD-10 code.
+2 NEW IBDCODE
+3 IF $GET(X)=""
KILL X
QUIT
+4 IF X["?"
DO INPHLP^IBDLXDG
KILL X
QUIT
+5 DO SETPARAM^IBDLXDG(.IBDPARAM)
+6 SET IBDCODE=$$LEXICD10^IBDLXDG(X,$$ICD10DT^IBDUTICD(DT),.IBDPARAM)
+7 IF IBDCODE=""
WRITE !!,IBDPARAM("NO DATA FOUND"),!,IBDPARAM("NO DATA FOUND 2"),!
KILL X
QUIT
+8 ;Timed out or was aborted.
IF IBDCODE=-1!(IBDCODE=-2)!(IBDCODE=-3)!(IBDCODE=-4)
KILL X
QUIT
+9 SET X=$PIECE($PIECE(IBDCODE,U),";",2)
+10 ;
+11 QUIT
SLCTDX(X) ;for ICD9 diagnosis codes
+1 ;pass X by reference
+2 ;example of use: D SLCTICD^IBDFN12(.X)
+3 ;
+4 NEW NODE,SCRN
+5 ;;D LOOKUP(80,"I '$P(^(0),U,9)",.X,.NODE)
+6 ;
+7 ;List only active code. (CSV)
+8 ;Check status for ICD (CSV)
SET SCRN="I $P($$ICDDX^ICDCODE(Y),U,10)=1"
+9 DO LOOKUP(80,SCRN,.X,.NODE)
+10 IF $DATA(X)
SET IBLABEL=$PIECE(NODE,"^",3)
SET (IBID,X)=$PIECE(NODE,"^",1)
+11 QUIT
+12 ;
SLCTVST(X) ;for VISIT TYPE codes
+1 ;pass X by reference
+2 ;example of use: D SLCTVST^IBDFN12(.X)
+3 ;
+4 NEW NODE,SCREEN
+5 ;;D LOOKUP(357.69,"I '$P(^(0),U,4)",.X,.NODE)
+6 ;
+7 ;List only active code. (CSV)
+8 ;Check status for CPT (CSV)
SET SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1"
+9 DO LOOKUP(357.69,SCRN,.X,.NODE)
+10 ;
+11 ;; --change to api cpt ; dhh
+12 IF $GET(X)
SET NODE=$$CPT^ICPTCOD(+NODE)
SET NODE=$GET(NODE)
SET (IBID,X)=$PIECE(NODE,"^",2)
SET IBLABEL=$PIECE(NODE,"^",3)
+13 QUIT
+14 ;
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
