- 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
