BPCLORD.m

BPCLORD ; IHS/OIT/MJL - GUI CHART LAB ORDER SCREEN ;

 ;;1.5;BPC;;MAY 26, 2005

 ;LISTS TESTS FOR ORDERING FROM LAB ACCESSION AREA LISTING

 ;LISTS WARDS

GETPICK(RESULT) ;EP REMOTE PROC: BPC GETPICKLIST

 ; Get default pick list from BLR MASTER CONTROL File

 K RESULT S XWBWRAP=1

 I '$D(^BLRSITE("B",DUZ(2))) S RESULT(1)=-1,RESULT(2)="NO PICK LIST Defined In BLR MASTER CONTROL FILE!" Q

 S BPCIEN=$O(^BLRSITE("B",DUZ(2),"")),BPCDTA=^BLRSITE(BPCIEN,11),BPCPICK=$P(BPCDTA,U,5)

 D

 .I BPCPICK="" S RESULT(1)=-1,RESULT(2)="NO PICK LIST Defined In BLR MASTER CONTROL FILE!" Q

 .S DIC="^LAB(62.6,",DIC(0)="X",X=BPCPICK D ^DIC K DIC I Y<1 S RESULT(1)=-1,RESULT(2)=BPCPICK_" NOT defined in ACCESSION TEST GROUP FILE" Q

 .S RESULT(1)=2,RESULT(2)=+Y,RESULT(3)=BPCPICK

 K BPCDTA,BPCIEN,BPCPICK

 Q

 ;

LISTT(RESULT,BPCPARAM) ;;EP REMOTE PROC: BPC ORDERSCREEN

 ;

 K RESULT

 ; RESERVE THE 1ST ELEMENT OF RESULT FOR THE COUNT

 S BPCAG=BPCPARAM,XWBWRAP=1,BPCCTR=1

 S X=0 F  S X=$O(^LAB(62.6,BPCAG,1,X)) Q:'X  S BPCVAL=$G(^LAB(62.6,BPCAG,1,X,0)) I BPCVAL S BPCCTR=BPCCTR+1,RESULT(BPCCTR)="TEST"_U_$P(BPCVAL,U,2)_U_$P(BPCVAL,U,1)_U_$P(BPCVAL,U,4)_U_$P(^LAB(60,$P(BPCVAL,U),0),U,19)

 ;D LOC  ; CALL COMMENTED SINCE IT SEEMED EXTRANEOUS -- MJL

 S RESULT(1)=BPCCTR-1

 K BPCAG,BPCCTR,BPCVAL

 Q

 ;

LOC ;GETS HOSPITAL LOCATION LIST

 S FILE=44,IEN="",FIELDS="1",NUMBER=999,FROM="",TROOT="^BPCTEMP("_$J_")",PARAM=""

 D LISTL

 Q

LISTL ;

 K ^BPCTEMP($J) S DIQUIET=1 S FLAGS="Q",PART="",INDEX="C",SCREEN="",IDENT="",TROOT="^BPCTEMP("_$J_")"

 D LIST^DIC(FILE,IEN,FIELDS,FLAGS,NUMBER,FROM,PART,INDEX,SCREEN,IDENT,TROOT)

 S X=0 F  S X=$O(^BPCTEMP($J,"DILIST","ID",X)) Q:+X=0  D L1 S RESULT(BPCCTR)="LOC"_U_$G(^BPCTEMP($J,"DILIST",2,X))_"^"_$G(F) S BPCCTR=BPCCTR+1

 Q

L1 S F="" F I=1:1 S Y=$P(FIELDS,";",I) Q:'Y  D

 .S F=F_^BPCTEMP($J,"DILIST","ID",X,Y)_"^"

 Q

BPCLORD   ; IHS/OIT/MJL - GUI CHART LAB ORDER SCREEN ;

 +1       ;;1.5;BPC;;MAY 26, 2005

 +2       ;LISTS TESTS FOR ORDERING FROM LAB ACCESSION AREA LISTING

 +3       ;LISTS WARDS

GETPICK(RESULT) ;EP REMOTE PROC: BPC GETPICKLIST

 +1       ; Get default pick list from BLR MASTER CONTROL File

 +2        KILL RESULT

           SET XWBWRAP=1

 +3        IF '$DATA(^BLRSITE("B",DUZ(2)))

               SET RESULT(1)=-1

               SET RESULT(2)="NO PICK LIST Defined In BLR MASTER CONTROL FILE!"

               QUIT 

 +4        SET BPCIEN=$ORDER(^BLRSITE("B",DUZ(2),""))

           SET BPCDTA=^BLRSITE(BPCIEN,11)

           SET BPCPICK=$PIECE(BPCDTA,U,5)

 +5        Begin DoDot:1

 +6            IF BPCPICK=""

                   SET RESULT(1)=-1

                   SET RESULT(2)="NO PICK LIST Defined In BLR MASTER CONTROL FILE!"

                   QUIT 

 +7            SET DIC="^LAB(62.6,"

               SET DIC(0)="X"

               SET X=BPCPICK

               DO ^DIC

               KILL DIC

               IF Y<1

                   SET RESULT(1)=-1

                   SET RESULT(2)=BPCPICK_" NOT defined in ACCESSION TEST GROUP FILE"

                   QUIT 

 +8            SET RESULT(1)=2

               SET RESULT(2)=+Y

               SET RESULT(3)=BPCPICK

           End DoDot:1

 +9        KILL BPCDTA,BPCIEN,BPCPICK

 +10       QUIT 

 +11      ;

LISTT(RESULT,BPCPARAM) ;;EP REMOTE PROC: BPC ORDERSCREEN

 +1       ;

 +2        KILL RESULT

 +3       ; RESERVE THE 1ST ELEMENT OF RESULT FOR THE COUNT

 +4        SET BPCAG=BPCPARAM

           SET XWBWRAP=1

           SET BPCCTR=1

 +5        SET X=0

           FOR 

               SET X=$ORDER(^LAB(62.6,BPCAG,1,X))

               IF 'X

                   QUIT 

               SET BPCVAL=$GET(^LAB(62.6,BPCAG,1,X,0))

               IF BPCVAL

                   SET BPCCTR=BPCCTR+1

                   SET RESULT(BPCCTR)="TEST"_U_$PIECE(BPCVAL,U,2)_U_$PIECE(BPCVAL,U,1)_U_$PIECE(BPCVAL,U,4)_U_$PIECE(^LAB(60,$PIECE(BPCVAL,U),0),U,19)

 +6       ;D LOC  ; CALL COMMENTED SINCE IT SEEMED EXTRANEOUS -- MJL

 +7        SET RESULT(1)=BPCCTR-1

 +8        KILL BPCAG,BPCCTR,BPCVAL

 +9        QUIT 

 +10      ;

LOC       ;GETS HOSPITAL LOCATION LIST

 +1        SET FILE=44

           SET IEN=""

           SET FIELDS="1"

           SET NUMBER=999

           SET FROM=""

           SET TROOT="^BPCTEMP("_$JOB_")"

           SET PARAM=""

 +2        DO LISTL

 +3        QUIT 

LISTL     ;

 +1        KILL ^BPCTEMP($JOB)

           SET DIQUIET=1

           SET FLAGS="Q"

           SET PART=""

           SET INDEX="C"

           SET SCREEN=""

           SET IDENT=""

           SET TROOT="^BPCTEMP("_$JOB_")"

 +2        DO LIST^DIC(FILE,IEN,FIELDS,FLAGS,NUMBER,FROM,PART,INDEX,SCREEN,IDENT,TROOT)

 +3        SET X=0

           FOR 

               SET X=$ORDER(^BPCTEMP($JOB,"DILIST","ID",X))

               IF +X=0

                   QUIT 

               DO L1

               SET RESULT(BPCCTR)="LOC"_U_$GET(^BPCTEMP($JOB,"DILIST",2,X))_"^"_$GET(F)

               SET BPCCTR=BPCCTR+1

 +4        QUIT 

L1         SET F=""

           FOR I=1:1

               SET Y=$PIECE(FIELDS,";",I)

               IF 'Y

                   QUIT 

               Begin DoDot:1

 +1                SET F=F_^BPCTEMP($JOB,"DILIST","ID",X,Y)_"^"

               End DoDot:1

 +2        QUIT