BGP4DEMO ; IHS/CMI/LAB - demo patient search template ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
;
;
UPDATE ;create/update Demo Patient Search Template
D INTRO
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
I 'Y D XIT Q
SELECT ;
W !!
K DIC
S DIC(0)="AEMQL",DIC("A")="Enter DEMO PATIENT Search Template: ",DIR("B")=$$VAL^XBDIQ1(90241.01,DUZ(2),.12),DIC="^DIBT(",DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" D ^DIC
I Y=-1 D XIT Q
S BGPSTMP=+Y
I $P(^DIBT(+Y,0),U,4)="" S DA=+Y,DIE="^DIBT(",DR="4////2" D ^DIE K DIE,DA,DR
;
;display the existing template patients
D EP
D XIT
Q
XIT ;
D EN^XBVK("BGP")
K DIR
D ^XBFMK
Q
;
INTRO ;
W:$D(IOF) @IOF
W !!,"CREATE/UPDATE ""DEMO"" PATIENT SEARCH TEMPLATE"
W !!,"This option is used to create or update a patient search template that"
W !,"contains the names of all of the ""demo"" or ""test"" patients in your"
W !,"database. This template will be used to exclude these patients from"
W !,"all CRS reports. Once the template is created you must remember to "
W !,"enter the name of the template into your site's CRS Site Parameter file"
W !,"using the Update Site Parameters option."
W !!
Q
;
;
;
;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
D EN^XBVK("BGP")
Q
;; ;
EN ;EP -- main entry point for
D EN^VALM("BGP 14 DEMO SEARCH TEMPLATE")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
HDR ; -- header code
S VALMHDR(1)="DEMO/TEST PATIENTS TO EXCLUDE FROM CRS REPORTS"
S VALMHDR(2)="* Patients currently included in the "_$P(^DIBT(BGPSTMP,0),U)_" search template"
S X="",$E(X,7)="Patient Name",$E(X,40)="HRN"
S VALMHDR(3)=X
Q
;
INIT ; -- init variables and list array
K BGPDEMO S BGPHIGH="",C=0
S X=0 F S X=$O(^DIBT(BGPSTMP,1,X)) Q:X'=+X D
.S C=C+1
.S BGPDEMO(C,0)=C_") "_$P(^DPT(X,0),U),$E(BGPDEMO(C,0),40)=$$HRN^AUPNPAT(X,DUZ(2))
.S BGPDEMO("IDX",C,C)=X
.Q
S (VALMCNT,BGPHIGH)=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
;
ADD ;EP - add an item to the selected list - called from a protocol
D FULL^VALM1
ADD1 W !!
K DIC S DIC=9000001,DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 G ADDX
I $D(^DIBT(BGPSTMP,1,+Y)) W !!,"That patient is already in the template." G ADD1
S ^DIBT(BGPSTMP,1,+Y)=""
G ADD1
ADDX ;
D BACK
Q
REM ;EP - REMOVE PATIENT FROM SEARCH TEMPLATE
W !
S DIR(0)="NO^1:"_BGPHIGH,DIR("A")="Remove which Patient (enter the number from the list)"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No patient selected." G REMX
I $D(DIRUT) W !,"No patient selected." G REMX
D FULL^VALM1 W:$D(IOF) @IOF
S BGPPATI=BGPDEMO("IDX",Y,Y)
W !!,$P(^DPT(BGPPATI,0),U)," removed from template.",!!
K ^DIBT(BGPSTMP,1,BGPPATI)
K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
REMX ;
D BACK
Q
BGP4DEMO ; IHS/CMI/LAB - demo patient search template ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
+3 ;
+4 ;
UPDATE ;create/update Demo Patient Search Template
+1 DO INTRO
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO XIT
QUIT
+4 IF 'Y
DO XIT
QUIT
SELECT ;
+1 WRITE !!
+2 KILL DIC
+3 SET DIC(0)="AEMQL"
SET DIC("A")="Enter DEMO PATIENT Search Template: "
SET DIR("B")=$$VAL^XBDIQ1(90241.01,DUZ(2),.12)
SET DIC="^DIBT("
SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
DO ^DIC
+4 IF Y=-1
DO XIT
QUIT
+5 SET BGPSTMP=+Y
+6 IF $PIECE(^DIBT(+Y,0),U,4)=""
SET DA=+Y
SET DIE="^DIBT("
SET DR="4////2"
DO ^DIE
KILL DIE,DA,DR
+7 ;
+8 ;display the existing template patients
+9 DO EP
+10 DO XIT
+11 QUIT
XIT ;
+1 DO EN^XBVK("BGP")
+2 KILL DIR
+3 DO ^XBFMK
+4 QUIT
+5 ;
INTRO ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,"CREATE/UPDATE ""DEMO"" PATIENT SEARCH TEMPLATE"
+3 WRITE !!,"This option is used to create or update a patient search template that"
+4 WRITE !,"contains the names of all of the ""demo"" or ""test"" patients in your"
+5 WRITE !,"database. This template will be used to exclude these patients from"
+6 WRITE !,"all CRS reports. Once the template is created you must remember to "
+7 WRITE !,"enter the name of the template into your site's CRS Site Parameter file"
+8 WRITE !,"using the Update Site Parameters option."
+9 WRITE !!
+10 QUIT
+11 ;
+12 ;
+13 ;
+14 ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 DO EN^XBVK("BGP")
+2 QUIT
+3 ;; ;
EN ;EP -- main entry point for
+1 DO EN^VALM("BGP 14 DEMO SEARCH TEMPLATE")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
HDR ; -- header code
+1 SET VALMHDR(1)="DEMO/TEST PATIENTS TO EXCLUDE FROM CRS REPORTS"
+2 SET VALMHDR(2)="* Patients currently included in the "_$PIECE(^DIBT(BGPSTMP,0),U)_" search template"
+3 SET X=""
SET $EXTRACT(X,7)="Patient Name"
SET $EXTRACT(X,40)="HRN"
+4 SET VALMHDR(3)=X
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 KILL BGPDEMO
SET BGPHIGH=""
SET C=0
+2 SET X=0
FOR
SET X=$ORDER(^DIBT(BGPSTMP,1,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 SET C=C+1
+4 SET BGPDEMO(C,0)=C_") "_$PIECE(^DPT(X,0),U)
SET $EXTRACT(BGPDEMO(C,0),40)=$$HRN^AUPNPAT(X,DUZ(2))
+5 SET BGPDEMO("IDX",C,C)=X
+6 QUIT
End DoDot:1
+7 SET (VALMCNT,BGPHIGH)=C
+8 QUIT
+9 ;
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 ;
ADD ;EP - add an item to the selected list - called from a protocol
+1 DO FULL^VALM1
ADD1 WRITE !!
+1 KILL DIC
SET DIC=9000001
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+2 IF Y=-1
GOTO ADDX
+3 IF $DATA(^DIBT(BGPSTMP,1,+Y))
WRITE !!,"That patient is already in the template."
GOTO ADD1
+4 SET ^DIBT(BGPSTMP,1,+Y)=""
+5 GOTO ADD1
ADDX ;
+1 DO BACK
+2 QUIT
REM ;EP - REMOVE PATIENT FROM SEARCH TEMPLATE
+1 WRITE !
+2 SET DIR(0)="NO^1:"_BGPHIGH
SET DIR("A")="Remove which Patient (enter the number from the list)"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF Y=""
WRITE !,"No patient selected."
GOTO REMX
+5 IF $DATA(DIRUT)
WRITE !,"No patient selected."
GOTO REMX
+6 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+7 SET BGPPATI=BGPDEMO("IDX",Y,Y)
+8 WRITE !!,$PIECE(^DPT(BGPPATI,0),U)," removed from template.",!!
+9 KILL ^DIBT(BGPSTMP,1,BGPPATI)
+10 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
REMX ;
+1 DO BACK
+2 QUIT
