IBDFN10.m

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

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