APCLACGI ; IHS/CMI/LAB - LIST ICARE PANELS
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
;
;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
Q
;; ;
EN ;EP -- main entry point for
D EN^VALM("APCL ICARE LIST")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
HDR ; -- header code
I APCLPTS="I" D
.S VALMHDR(1)="iCare Panels owned or shared by "_$$VAL^XBDIQ1(200,DUZ,.01)
.S VALMHDR(2)="Please select the iCare Panel you wish to report on."
.S X="",$E(X,7)="Panel Name",$E(X,40)="Total # Patients"
.S VALMHDR(3)=X
I APCLPTS="E" D
.S VALMHDR(1)="EHR Personal Lists owned or shared by "_$$VAL^XBDIQ1(200,DUZ,.01)
.S VALMHDR(2)="Please select the EHR Personal List you wish to report on."
.S X="",$E(X,7)="Panel Name" ;,$E(X,40)="Total # Patients"
.S VALMHDR(3)=X
Q
;
INIT ; -- init variables and list array
I APCLPTS="I" D ICARE
I APCLPTS="E" D EHR
Q
ICARE ;
S APCLDATA=""
K ^TMP("BQIPLRT",$J)
D LISTS^BQIPLRT(.APCLDATA)
K APCLICAR S APCLHIGH="",C=0
S X=0 F S X=$O(^TMP("BQIPLRT",$J,X)) Q:X'=+X D
.Q:$P(^TMP("BQIPLRT",$J,X),U,2)=""
.S C=C+1
.S APCLICAR(C,0)=C_") "_$P(^TMP("BQIPLRT",$J,X),U,5),$E(APCLICAR(C,0),40)=$P(^TMP("BQIPLRT",$J,X),U,8)
.S APCLICAR("IDX",C,C)=X
.Q
S (VALMCNT,APCLHIGH)=C
Q
EHR ;
S APCLDATA=""
K ^TMP("BQITABLE",$J)
D TAB^BQIUTB(.APCLDATA,"PERS")
K APCLICAR S APCLHIGH="",C=0
S X=0 F S X=$O(^TMP("BQITABLE",$J,X)) Q:X'=+X D
.Q:$P(^TMP("BQITABLE",$J,X),U,2)=""
.S C=C+1
.S APCLICAR(C,0)=C_") "_$P(^TMP("BQITABLE",$J,X),U,2) ;,$E(APCLICAR(C,0),40)=$P(^TMP("BQITABLE",$J,X),U,8)
.S APCLICAR("IDX",C,C)=X
.Q
S (VALMCNT,APCLHIGH)=C
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
;
SEL ;EP - add an item to the selected list - called from a protocol
D FULL^VALM1
ADD1 W !!
S DIR(0)="NO^1:"_APCLHIGH,DIR("A")="Which Group"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No group/panel selected." G DISPX
I $D(DIRUT) W !,"No group/panel selected." G DISPX
S APCLIEN=$P(APCLICAR("IDX",Y,Y),U,1)
I APCLPTS="I" S APCLICP=$P(^TMP("BQIPLRT",$J,APCLIEN),U,1)_U_$P(^TMP("BQIPLRT",$J,APCLIEN),U,3)_U_$P(^TMP("BQIPLRT",$J,APCLIEN),U,5)
I APCLPTS="E" S APCLICP=DUZ_U_$P(^TMP("BQITABLE",$J,X),U,1)_U_$P($P(^TMP("BQITABLE",$J,X),U,2),"_")
Q
DISPX ;
D BACK
Q
APCLACGI ; IHS/CMI/LAB - LIST ICARE PANELS
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
+4 ;
+5 ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 QUIT
+2 ;; ;
EN ;EP -- main entry point for
+1 DO EN^VALM("APCL ICARE LIST")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
HDR ; -- header code
+1 IF APCLPTS="I"
Begin DoDot:1
+2 SET VALMHDR(1)="iCare Panels owned or shared by "_$$VAL^XBDIQ1(200,DUZ,.01)
+3 SET VALMHDR(2)="Please select the iCare Panel you wish to report on."
+4 SET X=""
SET $EXTRACT(X,7)="Panel Name"
SET $EXTRACT(X,40)="Total # Patients"
+5 SET VALMHDR(3)=X
End DoDot:1
+6 IF APCLPTS="E"
Begin DoDot:1
+7 SET VALMHDR(1)="EHR Personal Lists owned or shared by "_$$VAL^XBDIQ1(200,DUZ,.01)
+8 SET VALMHDR(2)="Please select the EHR Personal List you wish to report on."
+9 ;,$E(X,40)="Total # Patients"
SET X=""
SET $EXTRACT(X,7)="Panel Name"
+10 SET VALMHDR(3)=X
End DoDot:1
+11 QUIT
+12 ;
INIT ; -- init variables and list array
+1 IF APCLPTS="I"
DO ICARE
+2 IF APCLPTS="E"
DO EHR
+3 QUIT
ICARE ;
+1 SET APCLDATA=""
+2 KILL ^TMP("BQIPLRT",$JOB)
+3 DO LISTS^BQIPLRT(.APCLDATA)
+4 KILL APCLICAR
SET APCLHIGH=""
SET C=0
+5 SET X=0
FOR
SET X=$ORDER(^TMP("BQIPLRT",$JOB,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 IF $PIECE(^TMP("BQIPLRT",$JOB,X),U,2)=""
QUIT
+7 SET C=C+1
+8 SET APCLICAR(C,0)=C_") "_$PIECE(^TMP("BQIPLRT",$JOB,X),U,5)
SET $EXTRACT(APCLICAR(C,0),40)=$PIECE(^TMP("BQIPLRT",$JOB,X),U,8)
+9 SET APCLICAR("IDX",C,C)=X
+10 QUIT
End DoDot:1
+11 SET (VALMCNT,APCLHIGH)=C
+12 QUIT
EHR ;
+1 SET APCLDATA=""
+2 KILL ^TMP("BQITABLE",$JOB)
+3 DO TAB^BQIUTB(.APCLDATA,"PERS")
+4 KILL APCLICAR
SET APCLHIGH=""
SET C=0
+5 SET X=0
FOR
SET X=$ORDER(^TMP("BQITABLE",$JOB,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 IF $PIECE(^TMP("BQITABLE",$JOB,X),U,2)=""
QUIT
+7 SET C=C+1
+8 ;,$E(APCLICAR(C,0),40)=$P(^TMP("BQITABLE",$J,X),U,8)
SET APCLICAR(C,0)=C_") "_$PIECE(^TMP("BQITABLE",$JOB,X),U,2)
+9 SET APCLICAR("IDX",C,C)=X
+10 QUIT
End DoDot:1
+11 SET (VALMCNT,APCLHIGH)=C
+12 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
+8 ;
SEL ;EP - add an item to the selected list - called from a protocol
+1 DO FULL^VALM1
ADD1 WRITE !!
+1 SET DIR(0)="NO^1:"_APCLHIGH
SET DIR("A")="Which Group"
+2 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=""
WRITE !,"No group/panel selected."
GOTO DISPX
+4 IF $DATA(DIRUT)
WRITE !,"No group/panel selected."
GOTO DISPX
+5 SET APCLIEN=$PIECE(APCLICAR("IDX",Y,Y),U,1)
+6 IF APCLPTS="I"
SET APCLICP=$PIECE(^TMP("BQIPLRT",$JOB,APCLIEN),U,1)_U_$PIECE(^TMP("BQIPLRT",$JOB,APCLIEN),U,3)_U_$PIECE(^TMP("BQIPLRT",$JOB,APCLIEN),U,5)
+7 IF APCLPTS="E"
SET APCLICP=DUZ_U_$PIECE(^TMP("BQITABLE",$JOB,X),U,1)_U_$PIECE($PIECE(^TMP("BQITABLE",$JOB,X),U,2),"_")
+8 QUIT
DISPX ;
+1 DO BACK
+2 QUIT
