VENPCC1N ; IHS/OIT/GIS - DISPLAY LAB TEST RESULTS ;
;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
;
LAB(DFN,DEFEF) ; EP-GET LAB INFO
N STG,TMP,NAME,POC,GBL,LNAME,LIEN,SFIEN,%,AFLAG,ORD,MAX,POC,POCFLAG,TOT,MAXL
I '$D(^DPT(+$G(DFN),0)) Q ; MUST BE A VALID PATIENT
I '$D(^VEN(7.41,+$G(DEFEF),0)) Q ; MUST BE A VALID TEMPLATE
;
INIT ; EP - INITIALIZE VARIABLES
S AFLAG=$P($G(^VEN(7.41,DEFEF,5)),U,23) ; DIPLAY SORT: 1=ALPHABETICAL,0=ORDINAL
S TMP=$NA(^TMP("VEN PRNT",$J)) ; MAIL MERGE GLOBAL
S GBL=$NA(^TMP("VEN LAB ORDER",$J)) K @GBL ; ORDER GLOBAL
S MAXL=58
S %=$P($G(^VEN(7.41,DEFEF,1)),U,7) I % S MAXL=% ; MAX # LAB RESULTS ALLOWED ON THE FORM
;
ORD ; EP - PUT TEST NAMES IN ORDER
S SFIEN=0
F S SFIEN=$O(^VEN(7.41,DEFEF,7,SFIEN)) Q:'SFIEN D ; LOOP THRU LAB TESTS
. S POC=+$P(^VEN(7.41,DEFEF,7,SFIEN,0),U,6) ; POINT OF CARE TEST
. S LNAME=$P(^VEN(7.41,DEFEF,7,SFIEN,0),U,3) ; GET DISPLAY NAME IF IT EXISTS
. I '$L(LNAME) D ; IF NOT DISPLAY NAME, USE DEFAULT NAME FROM LAB TEST FILE
.. S LIEN=+^VEN(7.41,DEFEF,7,SFIEN,0) I 'LIEN Q
.. S LNAME=$P($G(^LAB(60,LIEN,0)),U) ; PATCHED BY GIS/OIT 10/17/05 ; PCC+ 2.5 PATCH 1
.. Q
. I '$L(LNAME) Q
. I AFLAG,POC S @GBL@("POC",LNAME)=SFIEN_U_LNAME Q ; POC/ALPHABETICAL ORDER
. I AFLAG S @GBL@(LNAME)=SFIEN_U_LNAME Q ; ALPHABETICAL ORDER
. S ORD=$P(^VEN(7.41,DEFEF,7,SFIEN,0),U,4)
. I 'ORD S ORD=SFIEN+999999 ; THIS FORCES ITEMS WITH UNSPECIFIED ORDER TO THE END OF THE LIST - IN IEN ORDER
. I POC S @GBL@("POC",ORD)=SFIEN_U_LNAME Q ; POC/ORDINAL ORDER
. S @GBL@(ORD)=SFIEN_U_LNAME ; ORDINAL ORDER
. Q
LABX ; EP - GET LAB RESULTS
S TOT=0
S ORD="" F S ORD=$O(@GBL@(ORD)) Q:ORD="" I ORD'="POC" D PASS(@GBL@(ORD),.TOT,MAXL) I TOT=60 Q ; 1ST PASS - NON POC TESTS
I '$D(@GBL@("POC")) Q ; NO POINT OF CARE TESTS
I TOT>MAXL Q ; NO MORE ROOM
S TOT=TOT+1
S @TMP@(1,"lt"_TOT)="*** POINT OF CARE TESTS ***" ; ADD DIVIDER LINE
S ORD="" F S ORD=$O(@GBL@("POC",ORD)) Q:ORD="" D PASS(@GBL@("POC",ORD),.TOT,MAXL) I TOT>MAXL Q ; 2ND PASS - POC TESTS
K @GBL
Q
;
PASS(LAB,TOT,MAXL) ; EP-FOR THIS PASS, GET LAB TESTS IN ORDER
N SFIEN,LNAME,STG,LIEN,CPT,DISPLAY,DATA,EP,%
S SFIEN=+LAB I 'SFIEN Q ; GET SUBFILE IEN FOR THIS LAB TEST
S LNAME=$P(LAB,U,2) I '$L(LNAME) Q ; GET NAME FOR THIS LAB TEST
S STG=$G(^VEN(7.41,DEFEF,7,SFIEN,0)) I '$L(STG) Q ; GET DATA STRING FOR THIS LAB TEST
S LIEN=+STG I 'LIEN Q
S CPT=$P(STG,U,2) I '$L(CPT) S CPT=$$CPT(LIEN) ; IF CPT NOT SPECIFIED, TRY CPT LOOKUP
I $P(STG,U,7) D Q ; DONT PRINT RESULT (USED FOR "ORDER ENTRY" ONLY)
. S TOT=TOT+1
. S @TMP@("lt"_TOT)=LNAME
. S @TMP@("lt"_TOT_"a")=CPT
. Q
S EP=$G(^VEN(7.41,DEFEF,7,SFIEN,1))
I '$L(EP) D LAB1(DFN,STG,LNAME,CPT,.TOT,MAXL) Q ; GET RESULTS FROM V LAB
D LAB2(DFN,STG,EP,LNAME,CPT,.TOT) ; SPECIAL CODE FOR OBTAINING RESULTS
; PATCHED BY GIS/OIT 08/17/06 ; PCC+ 2.5 PATCH 6
Q
;
LAB1(DFN,DATA,LNAME,CPT,TOT,MAXL) ; EP-RETRUN TEST NAME, CPT CODE AND RESULTS
; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
N IDT,DATE,RES,NAME,VLIEN,%,MAX,MAXM,MAXIDT,STOP,RES,VAL,CNT
I $G(DATA)="" Q ""
S MAX=$P(DATA,U,8) I 'MAX S MAX=1
S MAXM=$P(DATA,U,9) I 'MAXM S MAXM=12
S MAXIDT=$$MAXIDT(MAXM)
S STOP=0,IDT=0,CNT=0 ; PATCHED BY GIS/OIT 01/10/06 ; PCC+ 2.5 PATCH 2
F S IDT=$O(^AUPNVLAB("AA",DFN,LIEN,IDT)) Q:'IDT D I STOP Q ; MAIN LAB LOOP
. I IDT>MAXIDT S STOP=1 Q ; RESULT MUST BE WITHIN SPECIFIED DATE RANGE
. S VLIEN=999999999
. F S VLIEN=$O(^AUPNVLAB("AA",DFN,LIEN,IDT,VLIEN),-1) Q:'VLIEN D I STOP Q ; NO RESULT
.. S %=9999999-(IDT\1),DATE=$$FMTE^XLFDT(%,"2D")
.. S VAL=$P($G(^AUPNVLAB(VLIEN,0)),U,4) I '$L(VAL) Q
.. S RES=LNAME_": "_VAL_" ("_DATE_")"
.. S TOT=TOT+1 I TOT=MAXL S STOP=1 ; = MAX # OF RESULTS FOR ALL TESTS
.. S CNT=CNT+1 I CNT=MAX S STOP=1 ; = MAX # OF RESULTS FOR THIS TEST
.. S @TMP@(1,"lt"_TOT)=RES ; SAVE RESULT
.. S @TMP@(1,"lt"_TOT_"a")=$G(CPT) ; SAVE CPT
.. Q
. Q
Q
;
MAXIDT(MAXM) ; EP - GET LIMITING IDT
N MAXIDT,DATE,IDT,%
I MAXM=12 Q (9999999-(DT-10000))
S %=(30.5*MAXM)\1 S %=-%
S DATE=$$FMADD^XLFDT(DT,%,0,0,0)
S MAXIDT=9999999-DATE
Q MAXIDT
;
LAB2(DFN,DATA,EP,LNAME,CPT,TOT) ; EP-SPECIAL DISPLAY CODE
; SPECIAL TESTS WILL ONLY WORK IF TEST NAMES APPEAR IN THE LAB(60) FILE
N CODE,TXT,%
I '$L($G(EP)) Q ; EP MUST EXIST
X "I $L($T("_EP_"))" E Q ; EP MUST BE VALID
S CODE="D "_EP_"(DFN,DATA,LNAME,CPT,.TOT)"
X CODE
Q
;
CPT(LIEN) ; EP-GIVEN A LAB IEN RETURN THE CPT CODE
N CPTIEN,CPT,%,CIEN
I '$D(^LAB(60,+$G(LIEN),0)) Q "" ; INVALID/MISSING LAB TEST
I '$D(^BLRCPT("C")) Q "" ; IHS LAB CPT CODE FILE MISSING
S CPTIEN=$O(^BLRCPT("C",LIEN,0)) I 'CPTIEN Q "" ; PANEL/TEST INDEX ("C")
I $P($G(^BLRCPT(CPTIEN,1)),U,2) Q "" ; CODE FOR THIS TEST IS INACTIVE
S %=$O(^BLRCPT(CPTIEN,11,0)) I '% Q "" ; GET FIRST MULTIPLE IEN
S CIEN=+$P(^BLRCPT(CPTIEN,11,%,0),U) I 'CIEN Q "" ; GET FIRST CPT CODE IEN
S CPT=$P($G(^ICPT(CIEN,0)),U) ; LOOKUP THE CPT CODE IN THE ICPT FILE
Q CPT ; RETURN THE CPT CODE
;
COPY ; EP-COPY LAB TESTS FROM ONE TEMPLATE TO ANOTHER
N DIC,X,Y,FROM,TO,TOT
W !,?5,"***** COPY LAB TEST LIST FROM ONE TEMPLATE TO ANOTHER *****",!!
S DIC("A")="Template that is the source of lab tests: "
S DIC(0)="AEQM",DIC="^VEN(7.41,"
D ^DIC I Y=-1 G CX
S FROM=+Y
S TOT=+$P($G(^VEN(7.41,+Y,7,0)),U,3)
W !,"There are ",TOT," tests associated with this template..."
I 'TOT W !,"Request terminated..." G CX
S DIC("A")="Copy these lab test to which template: "
D ^DIC I Y=-1 G CX
S TO=+Y,TOT=+$P($G(^VEN(7.41,+Y,7,0)),U,3)
I TOT W !,"Template ",$P(Y,U,2)," already has ",TOT," lab tests.",!,"These will be overwritten!"
W !!,"Sure you want to copy ",TOT," lab tests to ",$P(Y,U,2)
S %=1 D YN^DICN I %'=1 G CX
K ^VEN(7.41,TO,7) M ^VEN(7.41,TO,7)=^VEN(7.41,FROM,7)
W !,"All lab tests have been successfully copied!"
CX D ^XBFMK
Q
;
DEL ; EP-DELETE ALL LAB TESTS FROM A TEMPLATE
N DIC,X,Y,TOT
W !,?10,"***** REMOVE ALL LAB TESTS FROM A TEMPLATE *****",!!
S DIC("A")="Remove all tests from which template: "
S DIC(0)="AEQM",DIC="^VEN(7.41,"
D ^DIC I Y=-1 G DX
S TOT=+$P($G(^VEN(7.41,+Y,7,0)),U,3)
W !,"There are ",TOT," tests associated with this template..."
I 'TOT W !,"Request terminated..." G DX
W !!,"Sure you want to remove all lab tests from ",$P(Y,U,2)
S %=1 D YN^DICN I %'=1 G DX
K ^VEN(7.41,+Y,7)
W !,"All lab tests have been successfully removed from the template!"
DX D ^XBFMK
Q
;
VENPCC1N ; IHS/OIT/GIS - DISPLAY LAB TEST RESULTS ;
+1 ;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
+2 ;
LAB(DFN,DEFEF) ; EP-GET LAB INFO
+1 NEW STG,TMP,NAME,POC,GBL,LNAME,LIEN,SFIEN,%,AFLAG,ORD,MAX,POC,POCFLAG,TOT,MAXL
+2 ; MUST BE A VALID PATIENT
IF '$DATA(^DPT(+$GET(DFN),0))
QUIT
+3 ; MUST BE A VALID TEMPLATE
IF '$DATA(^VEN(7.41,+$GET(DEFEF),0))
QUIT
+4 ;
INIT ; EP - INITIALIZE VARIABLES
+1 ; DIPLAY SORT: 1=ALPHABETICAL,0=ORDINAL
SET AFLAG=$PIECE($GET(^VEN(7.41,DEFEF,5)),U,23)
+2 ; MAIL MERGE GLOBAL
SET TMP=$NAME(^TMP("VEN PRNT",$JOB))
+3 ; ORDER GLOBAL
SET GBL=$NAME(^TMP("VEN LAB ORDER",$JOB))
KILL @GBL
+4 SET MAXL=58
+5 ; MAX # LAB RESULTS ALLOWED ON THE FORM
SET %=$PIECE($GET(^VEN(7.41,DEFEF,1)),U,7)
IF %
SET MAXL=%
+6 ;
ORD ; EP - PUT TEST NAMES IN ORDER
+1 SET SFIEN=0
+2 ; LOOP THRU LAB TESTS
FOR
SET SFIEN=$ORDER(^VEN(7.41,DEFEF,7,SFIEN))
IF 'SFIEN
QUIT
Begin DoDot:1
+3 ; POINT OF CARE TEST
SET POC=+$PIECE(^VEN(7.41,DEFEF,7,SFIEN,0),U,6)
+4 ; GET DISPLAY NAME IF IT EXISTS
SET LNAME=$PIECE(^VEN(7.41,DEFEF,7,SFIEN,0),U,3)
+5 ; IF NOT DISPLAY NAME, USE DEFAULT NAME FROM LAB TEST FILE
IF '$LENGTH(LNAME)
Begin DoDot:2
+6 SET LIEN=+^VEN(7.41,DEFEF,7,SFIEN,0)
IF 'LIEN
QUIT
+7 ; PATCHED BY GIS/OIT 10/17/05 ; PCC+ 2.5 PATCH 1
SET LNAME=$PIECE($GET(^LAB(60,LIEN,0)),U)
+8 QUIT
End DoDot:2
+9 IF '$LENGTH(LNAME)
QUIT
+10 ; POC/ALPHABETICAL ORDER
IF AFLAG
IF POC
SET @GBL@("POC",LNAME)=SFIEN_U_LNAME
QUIT
+11 ; ALPHABETICAL ORDER
IF AFLAG
SET @GBL@(LNAME)=SFIEN_U_LNAME
QUIT
+12 SET ORD=$PIECE(^VEN(7.41,DEFEF,7,SFIEN,0),U,4)
+13 ; THIS FORCES ITEMS WITH UNSPECIFIED ORDER TO THE END OF THE LIST - IN IEN ORDER
IF 'ORD
SET ORD=SFIEN+999999
+14 ; POC/ORDINAL ORDER
IF POC
SET @GBL@("POC",ORD)=SFIEN_U_LNAME
QUIT
+15 ; ORDINAL ORDER
SET @GBL@(ORD)=SFIEN_U_LNAME
+16 QUIT
End DoDot:1
LABX ; EP - GET LAB RESULTS
+1 SET TOT=0
+2 ; 1ST PASS - NON POC TESTS
SET ORD=""
FOR
SET ORD=$ORDER(@GBL@(ORD))
IF ORD=""
QUIT
IF ORD'="POC"
DO PASS(@GBL@(ORD),.TOT,MAXL)
IF TOT=60
QUIT
+3 ; NO POINT OF CARE TESTS
IF '$DATA(@GBL@("POC"))
QUIT
+4 ; NO MORE ROOM
IF TOT>MAXL
QUIT
+5 SET TOT=TOT+1
+6 ; ADD DIVIDER LINE
SET @TMP@(1,"lt"_TOT)="*** POINT OF CARE TESTS ***"
+7 ; 2ND PASS - POC TESTS
SET ORD=""
FOR
SET ORD=$ORDER(@GBL@("POC",ORD))
IF ORD=""
QUIT
DO PASS(@GBL@("POC",ORD),.TOT,MAXL)
IF TOT>MAXL
QUIT
+8 KILL @GBL
+9 QUIT
+10 ;
PASS(LAB,TOT,MAXL) ; EP-FOR THIS PASS, GET LAB TESTS IN ORDER
+1 NEW SFIEN,LNAME,STG,LIEN,CPT,DISPLAY,DATA,EP,%
+2 ; GET SUBFILE IEN FOR THIS LAB TEST
SET SFIEN=+LAB
IF 'SFIEN
QUIT
+3 ; GET NAME FOR THIS LAB TEST
SET LNAME=$PIECE(LAB,U,2)
IF '$LENGTH(LNAME)
QUIT
+4 ; GET DATA STRING FOR THIS LAB TEST
SET STG=$GET(^VEN(7.41,DEFEF,7,SFIEN,0))
IF '$LENGTH(STG)
QUIT
+5 SET LIEN=+STG
IF 'LIEN
QUIT
+6 ; IF CPT NOT SPECIFIED, TRY CPT LOOKUP
SET CPT=$PIECE(STG,U,2)
IF '$LENGTH(CPT)
SET CPT=$$CPT(LIEN)
+7 ; DONT PRINT RESULT (USED FOR "ORDER ENTRY" ONLY)
IF $PIECE(STG,U,7)
Begin DoDot:1
+8 SET TOT=TOT+1
+9 SET @TMP@("lt"_TOT)=LNAME
+10 SET @TMP@("lt"_TOT_"a")=CPT
+11 QUIT
End DoDot:1
QUIT
+12 SET EP=$GET(^VEN(7.41,DEFEF,7,SFIEN,1))
+13 ; GET RESULTS FROM V LAB
IF '$LENGTH(EP)
DO LAB1(DFN,STG,LNAME,CPT,.TOT,MAXL)
QUIT
+14 ; SPECIAL CODE FOR OBTAINING RESULTS
DO LAB2(DFN,STG,EP,LNAME,CPT,.TOT)
+15 ; PATCHED BY GIS/OIT 08/17/06 ; PCC+ 2.5 PATCH 6
+16 QUIT
+17 ;
LAB1(DFN,DATA,LNAME,CPT,TOT,MAXL) ; EP-RETRUN TEST NAME, CPT CODE AND RESULTS
+1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
+2 NEW IDT,DATE,RES,NAME,VLIEN,%,MAX,MAXM,MAXIDT,STOP,RES,VAL,CNT
+3 IF $GET(DATA)=""
QUIT ""
+4 SET MAX=$PIECE(DATA,U,8)
IF 'MAX
SET MAX=1
+5 SET MAXM=$PIECE(DATA,U,9)
IF 'MAXM
SET MAXM=12
+6 SET MAXIDT=$$MAXIDT(MAXM)
+7 ; PATCHED BY GIS/OIT 01/10/06 ; PCC+ 2.5 PATCH 2
SET STOP=0
SET IDT=0
SET CNT=0
+8 ; MAIN LAB LOOP
FOR
SET IDT=$ORDER(^AUPNVLAB("AA",DFN,LIEN,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+9 ; RESULT MUST BE WITHIN SPECIFIED DATE RANGE
IF IDT>MAXIDT
SET STOP=1
QUIT
+10 SET VLIEN=999999999
+11 ; NO RESULT
FOR
SET VLIEN=$ORDER(^AUPNVLAB("AA",DFN,LIEN,IDT,VLIEN),-1)
IF 'VLIEN
QUIT
Begin DoDot:2
+12 SET %=9999999-(IDT\1)
SET DATE=$$FMTE^XLFDT(%,"2D")
+13 SET VAL=$PIECE($GET(^AUPNVLAB(VLIEN,0)),U,4)
IF '$LENGTH(VAL)
QUIT
+14 SET RES=LNAME_": "_VAL_" ("_DATE_")"
+15 ; = MAX # OF RESULTS FOR ALL TESTS
SET TOT=TOT+1
IF TOT=MAXL
SET STOP=1
+16 ; = MAX # OF RESULTS FOR THIS TEST
SET CNT=CNT+1
IF CNT=MAX
SET STOP=1
+17 ; SAVE RESULT
SET @TMP@(1,"lt"_TOT)=RES
+18 ; SAVE CPT
SET @TMP@(1,"lt"_TOT_"a")=$GET(CPT)
+19 QUIT
End DoDot:2
IF STOP
QUIT
+20 QUIT
End DoDot:1
IF STOP
QUIT
+21 QUIT
+22 ;
MAXIDT(MAXM) ; EP - GET LIMITING IDT
+1 NEW MAXIDT,DATE,IDT,%
+2 IF MAXM=12
QUIT (9999999-(DT-10000))
+3 SET %=(30.5*MAXM)\1
SET %=-%
+4 SET DATE=$$FMADD^XLFDT(DT,%,0,0,0)
+5 SET MAXIDT=9999999-DATE
+6 QUIT MAXIDT
+7 ;
LAB2(DFN,DATA,EP,LNAME,CPT,TOT) ; EP-SPECIAL DISPLAY CODE
+1 ; SPECIAL TESTS WILL ONLY WORK IF TEST NAMES APPEAR IN THE LAB(60) FILE
+2 NEW CODE,TXT,%
+3 ; EP MUST EXIST
IF '$LENGTH($GET(EP))
QUIT
+4 ; EP MUST BE VALID
XECUTE "I $L($T("_EP_"))"
IF '$TEST
QUIT
+5 SET CODE="D "_EP_"(DFN,DATA,LNAME,CPT,.TOT)"
+6 XECUTE CODE
+7 QUIT
+8 ;
CPT(LIEN) ; EP-GIVEN A LAB IEN RETURN THE CPT CODE
+1 NEW CPTIEN,CPT,%,CIEN
+2 ; INVALID/MISSING LAB TEST
IF '$DATA(^LAB(60,+$GET(LIEN),0))
QUIT ""
+3 ; IHS LAB CPT CODE FILE MISSING
IF '$DATA(^BLRCPT("C"))
QUIT ""
+4 ; PANEL/TEST INDEX ("C")
SET CPTIEN=$ORDER(^BLRCPT("C",LIEN,0))
IF 'CPTIEN
QUIT ""
+5 ; CODE FOR THIS TEST IS INACTIVE
IF $PIECE($GET(^BLRCPT(CPTIEN,1)),U,2)
QUIT ""
+6 ; GET FIRST MULTIPLE IEN
SET %=$ORDER(^BLRCPT(CPTIEN,11,0))
IF '%
QUIT ""
+7 ; GET FIRST CPT CODE IEN
SET CIEN=+$PIECE(^BLRCPT(CPTIEN,11,%,0),U)
IF 'CIEN
QUIT ""
+8 ; LOOKUP THE CPT CODE IN THE ICPT FILE
SET CPT=$PIECE($GET(^ICPT(CIEN,0)),U)
+9 ; RETURN THE CPT CODE
QUIT CPT
+10 ;
COPY ; EP-COPY LAB TESTS FROM ONE TEMPLATE TO ANOTHER
+1 NEW DIC,X,Y,FROM,TO,TOT
+2 WRITE !,?5,"***** COPY LAB TEST LIST FROM ONE TEMPLATE TO ANOTHER *****",!!
+3 SET DIC("A")="Template that is the source of lab tests: "
+4 SET DIC(0)="AEQM"
SET DIC="^VEN(7.41,"
+5 DO ^DIC
IF Y=-1
GOTO CX
+6 SET FROM=+Y
+7 SET TOT=+$PIECE($GET(^VEN(7.41,+Y,7,0)),U,3)
+8 WRITE !,"There are ",TOT," tests associated with this template..."
+9 IF 'TOT
WRITE !,"Request terminated..."
GOTO CX
+10 SET DIC("A")="Copy these lab test to which template: "
+11 DO ^DIC
IF Y=-1
GOTO CX
+12 SET TO=+Y
SET TOT=+$PIECE($GET(^VEN(7.41,+Y,7,0)),U,3)
+13 IF TOT
WRITE !,"Template ",$PIECE(Y,U,2)," already has ",TOT," lab tests.",!,"These will be overwritten!"
+14 WRITE !!,"Sure you want to copy ",TOT," lab tests to ",$PIECE(Y,U,2)
+15 SET %=1
DO YN^DICN
IF %'=1
GOTO CX
+16 KILL ^VEN(7.41,TO,7)
MERGE ^VEN(7.41,TO,7)=^VEN(7.41,FROM,7)
+17 WRITE !,"All lab tests have been successfully copied!"
CX DO ^XBFMK
+1 QUIT
+2 ;
DEL ; EP-DELETE ALL LAB TESTS FROM A TEMPLATE
+1 NEW DIC,X,Y,TOT
+2 WRITE !,?10,"***** REMOVE ALL LAB TESTS FROM A TEMPLATE *****",!!
+3 SET DIC("A")="Remove all tests from which template: "
+4 SET DIC(0)="AEQM"
SET DIC="^VEN(7.41,"
+5 DO ^DIC
IF Y=-1
GOTO DX
+6 SET TOT=+$PIECE($GET(^VEN(7.41,+Y,7,0)),U,3)
+7 WRITE !,"There are ",TOT," tests associated with this template..."
+8 IF 'TOT
WRITE !,"Request terminated..."
GOTO DX
+9 WRITE !!,"Sure you want to remove all lab tests from ",$PIECE(Y,U,2)
+10 SET %=1
DO YN^DICN
IF %'=1
GOTO DX
+11 KILL ^VEN(7.41,+Y,7)
+12 WRITE !,"All lab tests have been successfully removed from the template!"
DX DO ^XBFMK
+1 QUIT
+2 ;
