IBDFN10 ;ALB/AAS - ENCOUNTER FORM - (selection routines - mostly for PCE files) ; 5-Jun-95
;;3.0;AUTOMATED INFO COLLECTION SYS;**40**;APR 24, 1997
;
LOOK(DIC,SCREEN) ; -- Look up entry
I +$G(DIC)<1 Q
S DIC(0)="AEMQZ",DIC("S")=$G(SCREEN) D ^DIC K DIC
Q
;
EDTOP ; -- select Education Topics (from file 9999999.09)
N X,Y,SCREEN
I '$D(@IBARY@("SCREEN")) D EDSCRN
S SCREEN=$G(@IBARY@("SCREEN"))
D LOOK(9999999.09,SCREEN) I +Y<1 K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$P(Y(0),"^",1,2)
Q
EDSCRN ;
S @IBARY@("SCREEN")="I '$P(^(0),U,3)"
Q
;
IMM ; -- select Immunizations (from file 9999999.14)
N X,Y,SCREEN
I '$D(@IBARY@("SCREEN")) D IMSCRN
S SCREEN=$G(@IBARY@("SCREEN"))
D LOOK(9999999.14,SCREEN) I +Y<1 K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$P(Y(0),"^",1,3)
Q
IMSCRN ;
S @IBARY@("SCREEN")="I '$P(^(0),U,7)"
Q
;
EXAM ; -- select Exams (from file 9999999.15)
N X,Y,SCREEN
I '$D(@IBARY@("SCREEN")) D EXSCRN
S SCREEN=$G(@IBARY@("SCREEN"))
D LOOK(9999999.15,SCREEN) I +Y<1 K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$P(Y(0),"^",1,3)
Q
EXSCRN ;
S @IBARY@("SCREEN")="I '$P(^(0),U,4)"
Q
;
TRTMNT ; -- select treatments (from file 9999999.17)
N X,Y,SCREEN
I '$D(@IBARY@("SCREEN")) D TRSCRN
S SCREEN=$G(@IBARY@("SCREEN"))
D LOOK(9999999.17,SCREEN) I +Y<1 K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$P(Y(0),"^",1,2)
Q
TRSCRN ;
S @IBARY@("SCREEN")="I '$P(^(0),U,4)"
Q
;
SKINTST ; -- select Skin Tests (from file 9999999.28)
N X,Y,SCREEN
I '$D(@IBARY@("SCREEN")) D SKSCRN
S SCREEN=$G(@IBARY@("SCREEN"))
D LOOK(9999999.28,SCREEN) I +Y<1 K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$P(Y(0),"^",1,2)
Q
SKSCRN ;
S @IBARY@("SCREEN")="I '$P(^(0),U,3)"
Q
;
HF ; -- select Health Factors (from file 9999999.64)
N X,Y,SCREEN
I '$D(@IBARY@("SCREEN")) D HFSCRN
S SCREEN=$G(@IBARY@("SCREEN"))
D LOOK(9999999.64,SCREEN) I +Y<1 K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$P(Y(0),"^",1,5)
Q
HFSCRN ;
S @IBARY@("SCREEN")="I '$P(^(0),U,10),$P(^(0),U,10)=""F"",'$P(^(0),U,11)"
Q
;
CHECKOUT ;other visit dispositions than checkout
;the PCE GDI does not accept this now,but it may in the future
K DIR S DIR(0)="SO^1:No-show;2:Cancel;3:Rescheduled"
S DIR("A")="APPOINTMENT DISPOSITION TYPE"
D ^DIR
I $D(DIRUT) K @IBARY Q ;kill if nothing selected
S @IBARY=+Y_"^"_$S(+Y=1:"No-show",+Y=2:"Cancel",+Y=3:"Rescheduled",1:"")
K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN10 2513 printed Dec 13, 2024@02:52:48 Page 2
IBDFN10 ;ALB/AAS - ENCOUNTER FORM - (selection routines - mostly for PCE files) ; 5-Jun-95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**40**;APR 24, 1997
+2 ;
LOOK(DIC,SCREEN) ; -- Look up entry
+1 IF +$GET(DIC)<1
QUIT
+2 SET DIC(0)="AEMQZ"
SET DIC("S")=$GET(SCREEN)
DO ^DIC
KILL DIC
+3 QUIT
+4 ;
EDTOP ; -- select Education Topics (from file 9999999.09)
+1 NEW X,Y,SCREEN
+2 IF '$DATA(@IBARY@("SCREEN"))
DO EDSCRN
+3 SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 ;kill if nothing selected
DO LOOK(9999999.09,SCREEN)
IF +Y<1
KILL @IBARY
QUIT
+5 SET @IBARY=+Y_"^"_$PIECE(Y(0),"^",1,2)
+6 QUIT
EDSCRN ;
+1 SET @IBARY@("SCREEN")="I '$P(^(0),U,3)"
+2 QUIT
+3 ;
IMM ; -- select Immunizations (from file 9999999.14)
+1 NEW X,Y,SCREEN
+2 IF '$DATA(@IBARY@("SCREEN"))
DO IMSCRN
+3 SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 ;kill if nothing selected
DO LOOK(9999999.14,SCREEN)
IF +Y<1
KILL @IBARY
QUIT
+5 SET @IBARY=+Y_"^"_$PIECE(Y(0),"^",1,3)
+6 QUIT
IMSCRN ;
+1 SET @IBARY@("SCREEN")="I '$P(^(0),U,7)"
+2 QUIT
+3 ;
EXAM ; -- select Exams (from file 9999999.15)
+1 NEW X,Y,SCREEN
+2 IF '$DATA(@IBARY@("SCREEN"))
DO EXSCRN
+3 SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 ;kill if nothing selected
DO LOOK(9999999.15,SCREEN)
IF +Y<1
KILL @IBARY
QUIT
+5 SET @IBARY=+Y_"^"_$PIECE(Y(0),"^",1,3)
+6 QUIT
EXSCRN ;
+1 SET @IBARY@("SCREEN")="I '$P(^(0),U,4)"
+2 QUIT
+3 ;
TRTMNT ; -- select treatments (from file 9999999.17)
+1 NEW X,Y,SCREEN
+2 IF '$DATA(@IBARY@("SCREEN"))
DO TRSCRN
+3 SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 ;kill if nothing selected
DO LOOK(9999999.17,SCREEN)
IF +Y<1
KILL @IBARY
QUIT
+5 SET @IBARY=+Y_"^"_$PIECE(Y(0),"^",1,2)
+6 QUIT
TRSCRN ;
+1 SET @IBARY@("SCREEN")="I '$P(^(0),U,4)"
+2 QUIT
+3 ;
SKINTST ; -- select Skin Tests (from file 9999999.28)
+1 NEW X,Y,SCREEN
+2 IF '$DATA(@IBARY@("SCREEN"))
DO SKSCRN
+3 SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 ;kill if nothing selected
DO LOOK(9999999.28,SCREEN)
IF +Y<1
KILL @IBARY
QUIT
+5 SET @IBARY=+Y_"^"_$PIECE(Y(0),"^",1,2)
+6 QUIT
SKSCRN ;
+1 SET @IBARY@("SCREEN")="I '$P(^(0),U,3)"
+2 QUIT
+3 ;
HF ; -- select Health Factors (from file 9999999.64)
+1 NEW X,Y,SCREEN
+2 IF '$DATA(@IBARY@("SCREEN"))
DO HFSCRN
+3 SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 ;kill if nothing selected
DO LOOK(9999999.64,SCREEN)
IF +Y<1
KILL @IBARY
QUIT
+5 SET @IBARY=+Y_"^"_$PIECE(Y(0),"^",1,5)
+6 QUIT
HFSCRN ;
+1 SET @IBARY@("SCREEN")="I '$P(^(0),U,10),$P(^(0),U,10)=""F"",'$P(^(0),U,11)"
+2 QUIT
+3 ;
CHECKOUT ;other visit dispositions than checkout
+1 ;the PCE GDI does not accept this now,but it may in the future
+2 KILL DIR
SET DIR(0)="SO^1:No-show;2:Cancel;3:Rescheduled"
+3 SET DIR("A")="APPOINTMENT DISPOSITION TYPE"
+4 DO ^DIR
+5 ;kill if nothing selected
IF $DATA(DIRUT)
KILL @IBARY
QUIT
+6 SET @IBARY=+Y_"^"_$SELECT(+Y=1:"No-show",+Y=2:"Cancel",+Y=3:"Rescheduled",1:"")
+7 KILL DIR
+8 QUIT
