ECMLMN ;ALB/ESD - Multiple patients processing ;26 AUG 1997 14:42
;;2.0; EVENT CAPTURE ;**5,10,15,13,17,18,23,42,47,54,76**;8 May 96;Build 6
;
;
EN ;- Entry point for multiple patients (part of Multiple Dates/Procs option)
;
N ECGO,ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS
;
;- Ask patient related questions
D ENPAT(.ECGO)
;
;- ListMan entry point
I +$G(ECGO)=1 D EN^VALM("EC MUL PATIENTS")
;
Q
;
ENPAT(ECFL,ECONE) ;- Ask patient name, ordering section, inpat/outpat,
; dx, assoc clinic, and classification questions
; (AO, IR, EC, SC, MST, HNC, CV, SHAD)
;
SEL K ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS
S ECFL=1,ECS=""
;
;- Patient name
S ECNXT=$$ASKPAT^ECMUTL1(.ECPAT)
I ECNXT=-1!((ECNXT=-2)&('$D(^TMP("ECPAT",$J)))) S ECFL=-1 G ENPATQ
I ECNXT=-2,$D(^TMP("ECPAT",$J)) G ENPATQ
;
;- Inpatient/outpatient status (in ECPCE("I/O"))
I '$$INOUT^ECMUTL1(ECPAT) G ENPATQ
;
;- Patient eligibility (in ECPCE("ELIG"))
D ASKELIG^ECMUTL1(ECDSSU,ECPCE("I/O"),ECPAT)
;
;- Display inpatient/outpatient status on screen
D DSPSTAT^ECUTL0(ECPCE("I/O"))
;
;- Ordering section
S ECORD=$$ASKORD^ECMUTL1
I 'ECORD D REMOVE^ECMUTL1(ECPAT) G ENPATQ
;
;- Send Event Code Screen IEN of first procedure (used only if 'Send to
; PCE' fld in DSS Unit file is 'N' and patient is an inpatient)
;
I $P($G(^TMP("ECMPIDX",$J,1)),"^",3)]"" S ECS=$O(^ECJ("AP",ECL,+$P(ECDSSU,"^"),+ECCAT,$P($G(^TMP("ECMPIDX",$J,1)),"^",3),0))
;
;- Dx, associated clinic, and classification questions
S ECPCEQ=$$PCEDAT^ECMUTL1(+$P(ECDSSU,"^"),ECS,.ECPCE)
I ECPCEQ>0 D REMOVE^ECMUTL1(ECPAT) G ENPATQ
I ECPCEQ=0 D BLDPAT
ENPATQ I '$G(ECONE),ECNXT>0 W ! G SEL
Q
;
;
BLDPAT ;- Build ^TMP("ECPAT",$J) array with patient data
;
N ECNODE,ECNUM
S ECNUM=2
S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",12)=""
S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",1)=$P(ECPAT,"^",2)
S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",2)=+$P(ECORD,"^")
F ECNODE="I/O","CLIN","CLINNM","DX","DXNM","AO","ENV","IR","SC","ELIG","MST","HNC","CV","SHAD" D
. S ECNUM=ECNUM+1
. S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",ECNUM)=$S(ECNODE="CLINNM":$P($G(ECPCE("CLIN")),"^",2),ECNODE="DXNM":$P($G(ECPCE("DX")),"^",2),1:$P($G(ECPCE(ECNODE)),"^"))
I $D(ECPCE("DXS")) M ^TMP("ECPAT",$J,$P(ECPAT,"^"),"DXS")=ECPCE("DXS")
Q
;
;
HDR ;- Header
;
S VALMHDR(1)=" Location: "_$G(ECLN)_" ("_$G(ECL)_")"
S VALMHDR(1)=$$SETSTR^VALM1("Provider #1: "_$P(ECU(1),"^",2),VALMHDR(1),40,30)
S VALMHDR(2)=" DSS Unit: "_$P(ECDSSU,"^",2)
S VALMHDR(2)=$$SETSTR^VALM1(" Category: "_$P(ECCAT,"^",2),VALMHDR(2),40,30)
Q
;
;
INIT ;-- Init vars and display selected procedures for patient(s)
;
N ECPTCNT,BL,X,IC,IW,DC,DW,NC,NW,PC,PW,RC,RW,SC,SW
K ^TMP("ECMPT",$J),^TMP("ECMPTIDX",$J)
D CLEAN^VALM10
;
S (VALMCNT,ECPTCNT)=0
S BL="",$P(BL," ",30)=""
S X=VALMDDF("INDEX"),IC=$P(X,"^",2),IW=$P(X,"^",3)
S X=VALMDDF("PATIENT"),PC=$P(X,"^",2),PW=$P(X,"^",3)
S X=VALMDDF("SSN"),SC=$P(X,"^",2),SW=$P(X,"^",3)
;
D BLD
S $P(^TMP("ECMPT",$J,0),"^",4)=VALMCNT
Q
;
;
BLD ;- Get data from array for screen display
;
N DFN,ECDFN,ECX,VA,VAERR
S ECDFN=0 F S ECDFN=$O(^TMP("ECPAT",$J,ECDFN)) Q:'ECDFN D
. K DFN S DFN=ECDFN D PID^VADPT6
. D BLDLM
. D PRDSP
Q
;
;
BLDLM ;- Display patient data
;
K ECX
S ECPTCNT=ECPTCNT+1,ECX="",$P(ECX," ",VALMWD+1)=""
S ECX=$E(ECX,1,IC-1)_$E(ECPTCNT_BL,1,IW)_$E(ECX,IC+IW+1,VALMWD)
S ECX=$E(ECX,1,PC-1)_$E($P(^TMP("ECPAT",$J,ECDFN),"^")_BL,1,PW)_$E(ECX,PC+PW+1,VALMWD)
S ECX=$E(ECX,1,SC-1)_$E($G(VA("PID"))_BL,1,SW)_$E(ECX,SC+SW+1,VALMWD)
;
D SET(ECX)
;
;- Tmp array ECMPTIDX contains:
; Cnt^DFN^Name^Ord Sect^In/Out^Clin^Clin Nam^DX^DX Nam^AO^EC^IR^SC^Elig^MST^HNC^CV^SHAD
;
S ^TMP("ECMPTIDX",$J,ECPTCNT)=VALMCNT_"^"_ECDFN_"^"_$G(^TMP("ECPAT",$J,ECDFN))
;- Set secondary diagnosis codes in array ECMPTIDX
I $D(^TMP("ECPAT",$J,ECDFN,"DXS")) D
. M ^TMP("ECMPTIDX",$J,ECPTCNT,"DXS")=^TMP("ECPAT",$J,ECDFN,"DXS")
Q
;
;
SET(X) ;- Create ^TMP("ECMPT",$J) array for screen display
;
S VALMCNT=VALMCNT+1,^TMP("ECMPT",$J,VALMCNT,0)=X
S ^TMP("ECMPT",$J,"IDX",VALMCNT,ECPTCNT)=""
Q
;
;
PRDSP ;- Display selected procedure dates/times and procedures
;
N I,X,J,ECCPT,ECPR
S I=0
D SET("")
D SET($$SETSTR^VALM1("Procedure(s):","",8,13))
D CNTRL^VALM10(VALMCNT,8,13,IORVON,IORVOFF)
;
F S I=$O(^TMP("ECMPIDX",$J,I)) Q:'I D
. S X=""
. S X=$$SETSTR^VALM1($$FTIME^VALM1($P($G(^TMP("ECMPIDX",$J,I)),"^",2)),X,10,18)
. S X=$$SETSTR^VALM1($P($P($G(^TMP("ECMPIDX",$J,I)),"^",3),";"),X,34,5)
. S ECCPT=$P(^TMP("ECMPIDX",$J,I),"^",3)
. S ECCPT=$S(ECCPT["ICPT":+ECCPT,1:$P($G(^EC(725,+ECCPT,0)),"^",5))
. I ECCPT'="" S ECCPT=$P($$CPT^ICPTCOD(ECCPT,$P(^TMP("ECMPIDX",$J,I),"^",2)),"^",2)
. S ECPR=$S(ECCPT'="":ECCPT_" ",1:ECCPT)_$P(^TMP("ECMPIDX",$J,I),"^",4)
. S X=$$SETSTR^VALM1(ECPR,X,42,VALMWD)
. D SET(X)
. ;set modifier in ^TMP global for display
. S J="" F S J=$O(^TMP("ECMPIDX",$J,I,"MOD",J)) Q:J="" S X="" D
. . S X=$$SETSTR^VALM1(" - "_J_" "_$P(^TMP("ECMPIDX",$J,I,"MOD",J),"^"),X,41,VALMWD)
. . D SET(X)
;
D SET("")
;
PRDSPQ Q
;
HLPS ;- Brief help
;
S X="?" D DISP^XQORM1 W !!
Q
;
HELP ;- Help for list
S ECZ=""
I $D(X),X'["??" D HLPS,PAUSE^VALM1 G HLPQ
D CLEAR^VALM1
F I=1:1 S ECZ=$P($T(HELPTXT+I),";",3,99) Q:ECZ="$END" D PAUSE^VALM1:ECZ="$PAUSE" Q:'Y W !,$S(ECZ["$PAUSE":"",1:ECZ)
W !,"Possible actions are the following:"
D HLPS,PAUSE^VALM1 S VALMBCK="R"
HLPQ K ECZ,Y,I Q
;
EXIT ;- Clean up and exit
;
K ECPLST
K ^TMP("ECPAT",$J),^TMP("ECMPT",$J)
K VALMDDF
D CLEAN^VALM10,CLEAR^VALM1
Q
;
;
PATDEL ;- Entry point for EC MUL PAT DEL protocol
;
N ECFND,ECI,ECSEL,VALMY
S VALMBCK=""
D FULL^VALM1
D EN^VALM2(XQORNOD(0))
S (ECFND,ECSEL)=0
F S ECSEL=$O(VALMY(ECSEL)) Q:'ECSEL D
. I $D(^TMP("ECMPTIDX",$J,ECSEL)) K ECDAT S ECDAT=^(ECSEL) D
.. S ECI=0 F S ECI=$O(^TMP("ECPAT",$J,ECI)) Q:'ECI!(ECFND) D
... I $P(ECDAT,"^",2)=ECI S ECFND=1 K ^TMP("ECPAT",$J,ECI) D REMOVNM(ECI)
.. I ECFND=0 W !!,*7,">>> This patient could not be found. <<<" D PAUSE^VALM1 Q
I ECFND=1 D INIT^ECMLMN
S VALMBCK="R"
K ECDAT
PATDELQ Q
;
;
REMOVNM(ECI) ;- Remove patient name from array which tracks dup patients
;
Q:'$G(ECI)
N ECX
S ECX=0
F S ECX=$O(^TMP("ECPLST",$J,ECX)) Q:'ECX D
. I +$P($G(^TMP("ECPLST",$J,ECX)),"^")=ECI K ^TMP("ECPLST",$J,ECX)
Q
;
;
ADDPAT ;- Entry point for EC MUL PAT ADD protocol
;
N ECADD,ECOK
S VALMBCK=""
D FULL^VALM1
D ENPAT(.ECOK,1)
I +$G(ECOK)=1 D INIT^ECMLMN
I +$G(ECOK)<0 W !!,*7,">>> No patient entered. <<<" D PAUSE^VALM1
S VALMBCK="R"
ADDPATQ Q
;
;
HELPTXT ; - Help text
;;Enter actions(s) by typing the name(s), or abbreviation(s).
;;
;;ACTION DEFINITIONS:
;; AP - Add a Patient allows the user to add a Patient to those
;; patients previously entered
;; DP - Delete a Patient allows the user to delete a patient from
;; those patients previously entered
;; FP - File Patients will enter the patients into the Event Capture
;; procedure database
;;
;; NOTE: The procedures you have entered with this option MUST be filed
;; with the 'FP' action for the data to be filed into the Event
;; Capture system.
;;------------------------------------------------------------------------------
;;$PAUSE
;;$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECMLMN 7507 printed Dec 13, 2024@01:57:44 Page 2
ECMLMN ;ALB/ESD - Multiple patients processing ;26 AUG 1997 14:42
+1 ;;2.0; EVENT CAPTURE ;**5,10,15,13,17,18,23,42,47,54,76**;8 May 96;Build 6
+2 ;
+3 ;
EN ;- Entry point for multiple patients (part of Multiple Dates/Procs option)
+1 ;
+2 NEW ECGO,ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS
+3 ;
+4 ;- Ask patient related questions
+5 DO ENPAT(.ECGO)
+6 ;
+7 ;- ListMan entry point
+8 IF +$GET(ECGO)=1
DO EN^VALM("EC MUL PATIENTS")
+9 ;
+10 QUIT
+11 ;
ENPAT(ECFL,ECONE) ;- Ask patient name, ordering section, inpat/outpat,
+1 ; dx, assoc clinic, and classification questions
+2 ; (AO, IR, EC, SC, MST, HNC, CV, SHAD)
+3 ;
SEL KILL ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS
+1 SET ECFL=1
SET ECS=""
+2 ;
+3 ;- Patient name
+4 SET ECNXT=$$ASKPAT^ECMUTL1(.ECPAT)
+5 IF ECNXT=-1!((ECNXT=-2)&('$DATA(^TMP("ECPAT",$JOB))))
SET ECFL=-1
GOTO ENPATQ
+6 IF ECNXT=-2
IF $DATA(^TMP("ECPAT",$JOB))
GOTO ENPATQ
+7 ;
+8 ;- Inpatient/outpatient status (in ECPCE("I/O"))
+9 IF '$$INOUT^ECMUTL1(ECPAT)
GOTO ENPATQ
+10 ;
+11 ;- Patient eligibility (in ECPCE("ELIG"))
+12 DO ASKELIG^ECMUTL1(ECDSSU,ECPCE("I/O"),ECPAT)
+13 ;
+14 ;- Display inpatient/outpatient status on screen
+15 DO DSPSTAT^ECUTL0(ECPCE("I/O"))
+16 ;
+17 ;- Ordering section
+18 SET ECORD=$$ASKORD^ECMUTL1
+19 IF 'ECORD
DO REMOVE^ECMUTL1(ECPAT)
GOTO ENPATQ
+20 ;
+21 ;- Send Event Code Screen IEN of first procedure (used only if 'Send to
+22 ; PCE' fld in DSS Unit file is 'N' and patient is an inpatient)
+23 ;
+24 IF $PIECE($GET(^TMP("ECMPIDX",$JOB,1)),"^",3)]""
SET ECS=$ORDER(^ECJ("AP",ECL,+$PIECE(ECDSSU,"^"),+ECCAT,$PIECE($GET(^TMP("ECMPIDX",$JOB,1)),"^",3),0))
+25 ;
+26 ;- Dx, associated clinic, and classification questions
+27 SET ECPCEQ=$$PCEDAT^ECMUTL1(+$PIECE(ECDSSU,"^"),ECS,.ECPCE)
+28 IF ECPCEQ>0
DO REMOVE^ECMUTL1(ECPAT)
GOTO ENPATQ
+29 IF ECPCEQ=0
DO BLDPAT
ENPATQ IF '$GET(ECONE)
IF ECNXT>0
WRITE !
GOTO SEL
+1 QUIT
+2 ;
+3 ;
BLDPAT ;- Build ^TMP("ECPAT",$J) array with patient data
+1 ;
+2 NEW ECNODE,ECNUM
+3 SET ECNUM=2
+4 SET $PIECE(^TMP("ECPAT",$JOB,$PIECE(ECPAT,"^")),"^",12)=""
+5 SET $PIECE(^TMP("ECPAT",$JOB,$PIECE(ECPAT,"^")),"^",1)=$PIECE(ECPAT,"^",2)
+6 SET $PIECE(^TMP("ECPAT",$JOB,$PIECE(ECPAT,"^")),"^",2)=+$PIECE(ECORD,"^")
+7 FOR ECNODE="I/O","CLIN","CLINNM","DX","DXNM","AO","ENV","IR","SC","ELIG","MST","HNC","CV","SHAD"
Begin DoDot:1
+8 SET ECNUM=ECNUM+1
+9 SET $PIECE(^TMP("ECPAT",$JOB,$PIECE(ECPAT,"^")),"^",ECNUM)=$SELECT(ECNODE="CLINNM":$PIECE($GET(ECPCE("CLIN")),"^",2),ECNODE="DXNM":$PIECE($GET(ECPCE("DX")),"^",2),1:$PIECE($GET(ECPCE(ECNODE)),"^"))
End DoDot:1
+10 IF $DATA(ECPCE("DXS"))
MERGE ^TMP("ECPAT",$JOB,$PIECE(ECPAT,"^"),"DXS")=ECPCE("DXS")
+11 QUIT
+12 ;
+13 ;
HDR ;- Header
+1 ;
+2 SET VALMHDR(1)=" Location: "_$GET(ECLN)_" ("_$GET(ECL)_")"
+3 SET VALMHDR(1)=$$SETSTR^VALM1("Provider #1: "_$PIECE(ECU(1),"^",2),VALMHDR(1),40,30)
+4 SET VALMHDR(2)=" DSS Unit: "_$PIECE(ECDSSU,"^",2)
+5 SET VALMHDR(2)=$$SETSTR^VALM1(" Category: "_$PIECE(ECCAT,"^",2),VALMHDR(2),40,30)
+6 QUIT
+7 ;
+8 ;
INIT ;-- Init vars and display selected procedures for patient(s)
+1 ;
+2 NEW ECPTCNT,BL,X,IC,IW,DC,DW,NC,NW,PC,PW,RC,RW,SC,SW
+3 KILL ^TMP("ECMPT",$JOB),^TMP("ECMPTIDX",$JOB)
+4 DO CLEAN^VALM10
+5 ;
+6 SET (VALMCNT,ECPTCNT)=0
+7 SET BL=""
SET $PIECE(BL," ",30)=""
+8 SET X=VALMDDF("INDEX")
SET IC=$PIECE(X,"^",2)
SET IW=$PIECE(X,"^",3)
+9 SET X=VALMDDF("PATIENT")
SET PC=$PIECE(X,"^",2)
SET PW=$PIECE(X,"^",3)
+10 SET X=VALMDDF("SSN")
SET SC=$PIECE(X,"^",2)
SET SW=$PIECE(X,"^",3)
+11 ;
+12 DO BLD
+13 SET $PIECE(^TMP("ECMPT",$JOB,0),"^",4)=VALMCNT
+14 QUIT
+15 ;
+16 ;
BLD ;- Get data from array for screen display
+1 ;
+2 NEW DFN,ECDFN,ECX,VA,VAERR
+3 SET ECDFN=0
FOR
SET ECDFN=$ORDER(^TMP("ECPAT",$JOB,ECDFN))
if 'ECDFN
QUIT
Begin DoDot:1
+4 KILL DFN
SET DFN=ECDFN
DO PID^VADPT6
+5 DO BLDLM
+6 DO PRDSP
End DoDot:1
+7 QUIT
+8 ;
+9 ;
BLDLM ;- Display patient data
+1 ;
+2 KILL ECX
+3 SET ECPTCNT=ECPTCNT+1
SET ECX=""
SET $PIECE(ECX," ",VALMWD+1)=""
+4 SET ECX=$EXTRACT(ECX,1,IC-1)_$EXTRACT(ECPTCNT_BL,1,IW)_$EXTRACT(ECX,IC+IW+1,VALMWD)
+5 SET ECX=$EXTRACT(ECX,1,PC-1)_$EXTRACT($PIECE(^TMP("ECPAT",$JOB,ECDFN),"^")_BL,1,PW)_$EXTRACT(ECX,PC+PW+1,VALMWD)
+6 SET ECX=$EXTRACT(ECX,1,SC-1)_$EXTRACT($GET(VA("PID"))_BL,1,SW)_$EXTRACT(ECX,SC+SW+1,VALMWD)
+7 ;
+8 DO SET(ECX)
+9 ;
+10 ;- Tmp array ECMPTIDX contains:
+11 ; Cnt^DFN^Name^Ord Sect^In/Out^Clin^Clin Nam^DX^DX Nam^AO^EC^IR^SC^Elig^MST^HNC^CV^SHAD
+12 ;
+13 SET ^TMP("ECMPTIDX",$JOB,ECPTCNT)=VALMCNT_"^"_ECDFN_"^"_$GET(^TMP("ECPAT",$JOB,ECDFN))
+14 ;- Set secondary diagnosis codes in array ECMPTIDX
+15 IF $DATA(^TMP("ECPAT",$JOB,ECDFN,"DXS"))
Begin DoDot:1
+16 MERGE ^TMP("ECMPTIDX",$JOB,ECPTCNT,"DXS")=^TMP("ECPAT",$JOB,ECDFN,"DXS")
End DoDot:1
+17 QUIT
+18 ;
+19 ;
SET(X) ;- Create ^TMP("ECMPT",$J) array for screen display
+1 ;
+2 SET VALMCNT=VALMCNT+1
SET ^TMP("ECMPT",$JOB,VALMCNT,0)=X
+3 SET ^TMP("ECMPT",$JOB,"IDX",VALMCNT,ECPTCNT)=""
+4 QUIT
+5 ;
+6 ;
PRDSP ;- Display selected procedure dates/times and procedures
+1 ;
+2 NEW I,X,J,ECCPT,ECPR
+3 SET I=0
+4 DO SET("")
+5 DO SET($$SETSTR^VALM1("Procedure(s):","",8,13))
+6 DO CNTRL^VALM10(VALMCNT,8,13,IORVON,IORVOFF)
+7 ;
+8 FOR
SET I=$ORDER(^TMP("ECMPIDX",$JOB,I))
if 'I
QUIT
Begin DoDot:1
+9 SET X=""
+10 SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE($GET(^TMP("ECMPIDX",$JOB,I)),"^",2)),X,10,18)
+11 SET X=$$SETSTR^VALM1($PIECE($PIECE($GET(^TMP("ECMPIDX",$JOB,I)),"^",3),";"),X,34,5)
+12 SET ECCPT=$PIECE(^TMP("ECMPIDX",$JOB,I),"^",3)
+13 SET ECCPT=$SELECT(ECCPT["ICPT":+ECCPT,1:$PIECE($GET(^EC(725,+ECCPT,0)),"^",5))
+14 IF ECCPT'=""
SET ECCPT=$PIECE($$CPT^ICPTCOD(ECCPT,$PIECE(^TMP("ECMPIDX",$JOB,I),"^",2)),"^",2)
+15 SET ECPR=$SELECT(ECCPT'="":ECCPT_" ",1:ECCPT)_$PIECE(^TMP("ECMPIDX",$JOB,I),"^",4)
+16 SET X=$$SETSTR^VALM1(ECPR,X,42,VALMWD)
+17 DO SET(X)
+18 ;set modifier in ^TMP global for display
+19 SET J=""
FOR
SET J=$ORDER(^TMP("ECMPIDX",$JOB,I,"MOD",J))
if J=""
QUIT
SET X=""
Begin DoDot:2
+20 SET X=$$SETSTR^VALM1(" - "_J_" "_$PIECE(^TMP("ECMPIDX",$JOB,I,"MOD",J),"^"),X,41,VALMWD)
+21 DO SET(X)
End DoDot:2
End DoDot:1
+22 ;
+23 DO SET("")
+24 ;
PRDSPQ QUIT
+1 ;
HLPS ;- Brief help
+1 ;
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
HELP ;- Help for list
+1 SET ECZ=""
+2 IF $DATA(X)
IF X'["??"
DO HLPS
DO PAUSE^VALM1
GOTO HLPQ
+3 DO CLEAR^VALM1
+4 FOR I=1:1
SET ECZ=$PIECE($TEXT(HELPTXT+I),";",3,99)
if ECZ="$END"
QUIT
if ECZ="$PAUSE"
DO PAUSE^VALM1
if 'Y
QUIT
WRITE !,$SELECT(ECZ["$PAUSE":"",1:ECZ)
+5 WRITE !,"Possible actions are the following:"
+6 DO HLPS
DO PAUSE^VALM1
SET VALMBCK="R"
HLPQ KILL ECZ,Y,I
QUIT
+1 ;
EXIT ;- Clean up and exit
+1 ;
+2 KILL ECPLST
+3 KILL ^TMP("ECPAT",$JOB),^TMP("ECMPT",$JOB)
+4 KILL VALMDDF
+5 DO CLEAN^VALM10
DO CLEAR^VALM1
+6 QUIT
+7 ;
+8 ;
PATDEL ;- Entry point for EC MUL PAT DEL protocol
+1 ;
+2 NEW ECFND,ECI,ECSEL,VALMY
+3 SET VALMBCK=""
+4 DO FULL^VALM1
+5 DO EN^VALM2(XQORNOD(0))
+6 SET (ECFND,ECSEL)=0
+7 FOR
SET ECSEL=$ORDER(VALMY(ECSEL))
if 'ECSEL
QUIT
Begin DoDot:1
+8 IF $DATA(^TMP("ECMPTIDX",$JOB,ECSEL))
KILL ECDAT
SET ECDAT=^(ECSEL)
Begin DoDot:2
+9 SET ECI=0
FOR
SET ECI=$ORDER(^TMP("ECPAT",$JOB,ECI))
if 'ECI!(ECFND)
QUIT
Begin DoDot:3
+10 IF $PIECE(ECDAT,"^",2)=ECI
SET ECFND=1
KILL ^TMP("ECPAT",$JOB,ECI)
DO REMOVNM(ECI)
End DoDot:3
+11 IF ECFND=0
WRITE !!,*7,">>> This patient could not be found. <<<"
DO PAUSE^VALM1
QUIT
End DoDot:2
End DoDot:1
+12 IF ECFND=1
DO INIT^ECMLMN
+13 SET VALMBCK="R"
+14 KILL ECDAT
PATDELQ QUIT
+1 ;
+2 ;
REMOVNM(ECI) ;- Remove patient name from array which tracks dup patients
+1 ;
+2 if '$GET(ECI)
QUIT
+3 NEW ECX
+4 SET ECX=0
+5 FOR
SET ECX=$ORDER(^TMP("ECPLST",$JOB,ECX))
if 'ECX
QUIT
Begin DoDot:1
+6 IF +$PIECE($GET(^TMP("ECPLST",$JOB,ECX)),"^")=ECI
KILL ^TMP("ECPLST",$JOB,ECX)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
ADDPAT ;- Entry point for EC MUL PAT ADD protocol
+1 ;
+2 NEW ECADD,ECOK
+3 SET VALMBCK=""
+4 DO FULL^VALM1
+5 DO ENPAT(.ECOK,1)
+6 IF +$GET(ECOK)=1
DO INIT^ECMLMN
+7 IF +$GET(ECOK)<0
WRITE !!,*7,">>> No patient entered. <<<"
DO PAUSE^VALM1
+8 SET VALMBCK="R"
ADDPATQ QUIT
+1 ;
+2 ;
HELPTXT ; - Help text
+1 ;;Enter actions(s) by typing the name(s), or abbreviation(s).
+2 ;;
+3 ;;ACTION DEFINITIONS:
+4 ;; AP - Add a Patient allows the user to add a Patient to those
+5 ;; patients previously entered
+6 ;; DP - Delete a Patient allows the user to delete a patient from
+7 ;; those patients previously entered
+8 ;; FP - File Patients will enter the patients into the Event Capture
+9 ;; procedure database
+10 ;;
+11 ;; NOTE: The procedures you have entered with this option MUST be filed
+12 ;; with the 'FP' action for the data to be filed into the Event
+13 ;; Capture system.
+14 ;;------------------------------------------------------------------------------
+15 ;;$PAUSE
+16 ;;$END
