IBDFDE7 ;ALB/AAS - AICS Manual Data Entry, Entry point for Group Clinics ; 29-APR-96
;;3.0;AUTOMATED INFO COLLECTION SYS;**36,51**;APR 24, 1997
;
W !,?4,"** This option is OUT OF ORDER **" QUIT ;Code set Versioning
;
% N %,%H,C,I,J,X,Y,ADD,DEL,ASKOTHER,DIR,DIC,DA,CNT,DFN,DIRUT,DUOUT,DTOUT,POP,RTN,FRMDATA,IBDA,IBY,IBQUIT,IBDF,IBDOBJ,IBDPTSTI,IBDPTSTE,IBDPTNM,IBDPTDTI,SEL,IBD,IBDCKOUT
N IBDPTDTE,IBDFMNME,IBDFMIEN,IBDFMSTI,IBDFMSTE,IBDFMIDI,IBDCLNME,IBFORM,IBDCLNPH,IBDPID,IBDPTPRI,IBDSEL,IBDPI,IBDCO,PXCA,SDCLST,PXCASTAT,PXKNODA,PXKNODB,IBDREDIT,IBDASK,IBDPRE,IBDX,ANS,CLNAME,CLSETUP,IBDSC,FORM,FORMLST,IBDFDT
;
I '$D(DT) D DT^DICRW
D HOME^%ZIS
W !!,"Data Entry of Encounter Forms for Group Clinics",!
;
STRT ; -- ask for Clinic, appt. date/time
; list patients, allow to deselect
; find all forms for appt., then go through 1 at a time
; then send data for each patient
;
D END W !
S IBQUIT=0
S (IBDSC,IBDF("CLINIC"))=$$SELCL^IBDFDE6 G:IBQUIT STRTQ
I IBDSC<1 S IBQUIT=1 G STRTQ
S CLNAME=$P($G(^SC(+IBDSC,0)),"^")
S CLSETUP=$G(^SD(409.95,+$O(^SD(409.95,"B",+IBDSC,0)),0))
;
OVER ;
W !
S IBQUIT=0
S IBDFDT=$$SELAPT(.IBDF) G:IBQUIT STRTQ
I IBDFDT<0 G STRT
S IBDF("APPT")=IBDFDT
;
D BLD
I '$D(^TMP("IBD-PL",$J,IBDF("CLINIC"))) W !!,"No valid appointments at that Date/Time!",!! G STRTQ
;
D HDR^IBDFDE6,LIST^IBDFDE6
W !!
D EXCLUD
I IBQUIT=2 S IBQUIT=0 G STRTQ
G:IBQUIT STRTQ
;
; -- get first patient, check form(s)
; do data entry on form and if okay pass data for all patients
S IBDSTRT=+$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),0))
S NODE=$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBDSTRT))
S (DFN,IBDFN)=+NODE
S FORMLST=$$FINDID^IBDF18C(DFN,IBDF("APPT"),"",1)
I FORMLST="" W !,"No forms Printed for first Patient" D ANYWAY^IBDFDE6
I FORMLST="" G OVERQ
S IBDF("SAVE")=1 ;save ibdsel(array)
F IBDX=1:1 S IBDF("FORM")=$P(FORMLST,"^",IBDX) Q:IBDF("FORM")="" I IBDF("FORM")'="" D EN^IBDFDE D
.I $G(IBDF("NOTHING"))!(IBQUIT) W !! Q
.D ALLPTS K IBDSEL,IBDPI Q:IBQUIT
K IBDF("SAVE")
;
OVERQ G OVER
;
STRTQ D PAUSE^IBDFDE G:IBQUIT END
G STRT
;
ALLPTS ; -- loop through all patients, merge ibdf=^tmp("ibd-save),
; reset dfn, pass data to ibdfrpc4
N PARAM,FORMID,IBX,NODE
S FORMID=$P(^IBD(357.96,+IBDF("FORM"),0),"^",4)
S PARAM=$P($G(^IBD(357.09,1,0)),"^",7)
I $G(^TMP("IBD-SAVED",$J,"DYNAMIC")) W !!,"Form contains patient specific information, Not available for this option!",!! G ALLPTQ
S IBDA=IBDSTRT
F S IBDA=$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBDA)) Q:IBDA=""!(IBQUIT) D
.S IBX=IBDA
.S NODE=$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBX))
.M IBDF=^TMP("IBD-SAVED",$J)
.S (DFN,IBDF("DFN"))=+NODE
.S IBDF("SDOE")=$P(NODE,"^",22)
.S IBDF("FORM")=+$$FID^IBDF18C(DFN,IBDF("APPT"),1,FORMID,IBDF("CLINIC"))
.W !!,"Check out interview for: ",$P($G(^DPT(DFN,0)),"^")
.K IBDCO,IBDF("AO"),IBDF("SC"),IBDF("IR"),IBDF("EC"),IBDF("MST")
.D CHKOUT^IBDFDE0(IBDF("SDOE"))
.M IBDF=IBDCO
.D SEND^IBDFRPC4(.RESULT,.IBDF)
.I PARAM=3 D DISP^IBDFDE1
.I PARAM,$D(PXCA("ERROR"))!($D(PXCA("WARNING"))) D ERR^IBDFDE1
.I $P($G(^IBD(357.09,1,0)),"^",6) D MAKAPPT^IBDFDE1
;
K ^TMP("IBD-SAVED",$J)
ALLPTQ Q
;
SELAPT(IBDF) ; -- select appointment date/time for a clinic
N DIR,DA,DR,DIC,DIE,X,Y,ANS,DIRUT
S ANS=-1
S DIR(0)="DO^:NOW:AEXRT^D SCRN^IBDFDE7",DIR("A")="Appointment Date/Time"
S DIR("?")="Enter the date/time for the clinic that you wish to enter encounter forms for. Appointments must be present to enter the date time."
S DIR("??")="^D APDT^IBDFDE7"
D ^DIR K DIR
I $D(DIRUT) G SELAPQ
S ANS=+Y
SELAPQ Q ANS
;
SCRN ; -- input transform logic for selecting an appointment date/time
I $G(IBDF("CLINIC"))="" K X
I '$D(^SC(IBDF("CLINIC"),"S",Y,1)) W $C(7),"?? No appointments that time." K X
Q
;
EXCLUD ; -- select patient(s) to process
S RESULT=""
S DIR("?")="Enter the number of the patient to exclude."
S DIR("??")="^D LIST^IBDFDE6"
S DIR(0)="FO^1:30",DIR("A")="Exclude Patient"
I RESULT'="" S DIR("A")="Exclude Another Patient"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1 G EXCLUDQ
S ANS=Y
I ANS="" G EXCLUDQ
I ANS'=+ANS W !,"You must select a number from the list."
I ANS=+ANS,$D(^TMP("IBD-PL",$J,IBDF("CLINIC"),ANS)) D
.S RESULT=^TMP("IBD-PL",$J,IBDF("CLINIC"),ANS)
.K ^TMP("IBD-PL",$J,IBDF("CLINIC"),ANS),^TMP("IBD-PLN",$J,IBDF("CLINIC"),$P($G(^DPT(+RESULT,0)),"^"))
.W " ",$P($G(^DPT(+RESULT,0)),"^")," ","Excluded!"
;
I '$D(^TMP("IBD-PL",$J,IBDF("CLINIC"))) W !!,"No patients left" S IBQUIT=2 G EXCLUDQ
;
G EXCLUD
EXCLUDQ Q
;
BLD ; -- Find all appointments for a date
K ^TMP("IBD-PL",$J),^TMP("IBD-PLN",$J)
N SC,IBD,IBD1
S IBD=IBDFDT,SC=IBDF("CLINIC"),CNT=0
S IBD1=0 F S IBD1=$O(^SC(SC,"S",IBD,1,IBD1)) Q:'IBD1 D
.S NODE=$G(^SC(SC,"S",IBD,1,IBD1,0))
.S SNODE=$G(^DPT(+NODE,"S",IBD,0))
.S X=$P(SNODE,"^",2)
.I X'="","CNAPCA"[X Q ;inpatient appointments are okay
.S (DFN,IBDF("DFN"))=+NODE
.S CNT=CNT+1
.S ^TMP("IBD-PL",$J,SC,CNT)=DFN_"^"_IBD_"^"_SNODE
.S ^TMP("IBD-PLN",$J,SC,$P(^DPT(DFN,0),"^"))=DFN_"^"_IBD_"^"_SNODE
Q
;
LIST ; -- print list of patients
N IBD,IBJ,FORM,STATUS
S IBD=0 F S IBD=$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBD)) Q:'IBD D
.S DFN=+$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBD)),APPT=$P($G(^(IBD)),"^",2),SNODE=$P($G(^(IBD)),"^",3,99)
.S FORM=+$$FINDID^IBDF18C(DFN,APPT,"",1),STATUS="NO FORM PRINTED"
.I FORM S Y=$P($G(^IBD(357.96,+FORM,0)),"^",11),C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATUS=Y
.W !?2,IBD,?5,$E($P(^DPT(DFN,0),"^"),1,20),?29,$P($G(^DPT(DFN,.36)),"^",3),?43,$$FMTE^XLFDT(+APPT),?64,$E($G(STATUS),1,16)
Q
;
APDT ; -- list last 30 days appointment dates in clinic
S (X,Y)=$$FMADD^XLFDT(DT,-60),CNT=0
F S X=$O(^SC(IBDF("CLINIC"),"S",X)) Q:'X!(X>DT) D
.S Y=X,CNT=CNT+1
.I CNT=1 W !!,"The following are valid Appointment date/times in the past 60 days:"
.W:(CNT#3=1) !,?3,$$FMTE^XLFDT(Y)
.W:(CNT#3=2) ?30,$$FMTE^XLFDT(Y)
.W:(CNT#3=0) ?60,$$FMTE^XLFDT(Y)
Q
;
HDR ; -- print Clinic header
W @IOF
W !," Clinic: ",$E(CLNAME,1,25) W ?40," Date: ",$$FMTE^XLFDT(IBDFDT)
S FORM=$P(CLSETUP,"^",2),IBDFMNME=$P($G(^IBE(357,+FORM,0)),"^")
W !," Basic Form: ",$E(IBDFMNME,1,25) ;W ?40,"Form Status: ",$E(IBDFMSTE,1,25)
W !,$TR($J(" ",IOM)," ","=")
Q
;
END K I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDA,SDFN
K ^TMP("IBD-PL",$J),^TMP("IBD-PLN",$J),^TMP("IBD-SAVED",$J),^TMP("IBD-MORE",$J),^TMP("IBD-PLCHK",$J),^TMP("IBD-PL4",$J),^TMP("IBD-PLB",$J)
K ^TMP("IBD-ASK",$J),^TMP("IBD-LCODE",$J),^TMP("IBD-LST",$J),^TMP("IBD-LTEXT",$J),^TMP("IBD-OBJ",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFDE7 6740 printed Apr 09, 2024@21:59:03 Page 2
IBDFDE7 ;ALB/AAS - AICS Manual Data Entry, Entry point for Group Clinics ; 29-APR-96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**36,51**;APR 24, 1997
+2 ;
+3 ;Code set Versioning
WRITE !,?4,"** This option is OUT OF ORDER **"
QUIT
+4 ;
% NEW %,%H,C,I,J,X,Y,ADD,DEL,ASKOTHER,DIR,DIC,DA,CNT,DFN,DIRUT,DUOUT,DTOUT,POP,RTN,FRMDATA,IBDA,IBY,IBQUIT,IBDF,IBDOBJ,IBDPTSTI,IBDPTSTE,IBDPTNM,IBDPTDTI,SEL,IBD,IBDCKOUT
+1 NEW IBDPTDTE,IBDFMNME,IBDFMIEN,IBDFMSTI,IBDFMSTE,IBDFMIDI,IBDCLNME,IBFORM,IBDCLNPH,IBDPID,IBDPTPRI,IBDSEL,IBDPI,IBDCO,PXCA,SDCLST,PXCASTAT,PXKNODA,PXKNODB,IBDREDIT,IBDASK,IBDPRE,IBDX,ANS,CLNAME,CLSETUP,IBDSC,FORM,FORMLST,IBDFDT
+2 ;
+3 IF '$DATA(DT)
DO DT^DICRW
+4 DO HOME^%ZIS
+5 WRITE !!,"Data Entry of Encounter Forms for Group Clinics",!
+6 ;
STRT ; -- ask for Clinic, appt. date/time
+1 ; list patients, allow to deselect
+2 ; find all forms for appt., then go through 1 at a time
+3 ; then send data for each patient
+4 ;
+5 DO END
WRITE !
+6 SET IBQUIT=0
+7 SET (IBDSC,IBDF("CLINIC"))=$$SELCL^IBDFDE6
if IBQUIT
GOTO STRTQ
+8 IF IBDSC<1
SET IBQUIT=1
GOTO STRTQ
+9 SET CLNAME=$PIECE($GET(^SC(+IBDSC,0)),"^")
+10 SET CLSETUP=$GET(^SD(409.95,+$ORDER(^SD(409.95,"B",+IBDSC,0)),0))
+11 ;
OVER ;
+1 WRITE !
+2 SET IBQUIT=0
+3 SET IBDFDT=$$SELAPT(.IBDF)
if IBQUIT
GOTO STRTQ
+4 IF IBDFDT<0
GOTO STRT
+5 SET IBDF("APPT")=IBDFDT
+6 ;
+7 DO BLD
+8 IF '$DATA(^TMP("IBD-PL",$JOB,IBDF("CLINIC")))
WRITE !!,"No valid appointments at that Date/Time!",!!
GOTO STRTQ
+9 ;
+10 DO HDR^IBDFDE6
DO LIST^IBDFDE6
+11 WRITE !!
+12 DO EXCLUD
+13 IF IBQUIT=2
SET IBQUIT=0
GOTO STRTQ
+14 if IBQUIT
GOTO STRTQ
+15 ;
+16 ; -- get first patient, check form(s)
+17 ; do data entry on form and if okay pass data for all patients
+18 SET IBDSTRT=+$ORDER(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),0))
+19 SET NODE=$GET(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),IBDSTRT))
+20 SET (DFN,IBDFN)=+NODE
+21 SET FORMLST=$$FINDID^IBDF18C(DFN,IBDF("APPT"),"",1)
+22 IF FORMLST=""
WRITE !,"No forms Printed for first Patient"
DO ANYWAY^IBDFDE6
+23 IF FORMLST=""
GOTO OVERQ
+24 ;save ibdsel(array)
SET IBDF("SAVE")=1
+25 FOR IBDX=1:1
SET IBDF("FORM")=$PIECE(FORMLST,"^",IBDX)
if IBDF("FORM")=""
QUIT
IF IBDF("FORM")'=""
DO EN^IBDFDE
Begin DoDot:1
+26 IF $GET(IBDF("NOTHING"))!(IBQUIT)
WRITE !!
QUIT
+27 DO ALLPTS
KILL IBDSEL,IBDPI
if IBQUIT
QUIT
End DoDot:1
+28 KILL IBDF("SAVE")
+29 ;
OVERQ GOTO OVER
+1 ;
STRTQ DO PAUSE^IBDFDE
if IBQUIT
GOTO END
+1 GOTO STRT
+2 ;
ALLPTS ; -- loop through all patients, merge ibdf=^tmp("ibd-save),
+1 ; reset dfn, pass data to ibdfrpc4
+2 NEW PARAM,FORMID,IBX,NODE
+3 SET FORMID=$PIECE(^IBD(357.96,+IBDF("FORM"),0),"^",4)
+4 SET PARAM=$PIECE($GET(^IBD(357.09,1,0)),"^",7)
+5 IF $GET(^TMP("IBD-SAVED",$JOB,"DYNAMIC"))
WRITE !!,"Form contains patient specific information, Not available for this option!",!!
GOTO ALLPTQ
+6 SET IBDA=IBDSTRT
+7 FOR
SET IBDA=$ORDER(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),IBDA))
if IBDA=""!(IBQUIT)
QUIT
Begin DoDot:1
+8 SET IBX=IBDA
+9 SET NODE=$GET(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),IBX))
+10 MERGE IBDF=^TMP("IBD-SAVED",$JOB)
+11 SET (DFN,IBDF("DFN"))=+NODE
+12 SET IBDF("SDOE")=$PIECE(NODE,"^",22)
+13 SET IBDF("FORM")=+$$FID^IBDF18C(DFN,IBDF("APPT"),1,FORMID,IBDF("CLINIC"))
+14 WRITE !!,"Check out interview for: ",$PIECE($GET(^DPT(DFN,0)),"^")
+15 KILL IBDCO,IBDF("AO"),IBDF("SC"),IBDF("IR"),IBDF("EC"),IBDF("MST")
+16 DO CHKOUT^IBDFDE0(IBDF("SDOE"))
+17 MERGE IBDF=IBDCO
+18 DO SEND^IBDFRPC4(.RESULT,.IBDF)
+19 IF PARAM=3
DO DISP^IBDFDE1
+20 IF PARAM
IF $DATA(PXCA("ERROR"))!($DATA(PXCA("WARNING")))
DO ERR^IBDFDE1
+21 IF $PIECE($GET(^IBD(357.09,1,0)),"^",6)
DO MAKAPPT^IBDFDE1
End DoDot:1
+22 ;
+23 KILL ^TMP("IBD-SAVED",$JOB)
ALLPTQ QUIT
+1 ;
SELAPT(IBDF) ; -- select appointment date/time for a clinic
+1 NEW DIR,DA,DR,DIC,DIE,X,Y,ANS,DIRUT
+2 SET ANS=-1
+3 SET DIR(0)="DO^:NOW:AEXRT^D SCRN^IBDFDE7"
SET DIR("A")="Appointment Date/Time"
+4 SET DIR("?")="Enter the date/time for the clinic that you wish to enter encounter forms for. Appointments must be present to enter the date time."
+5 SET DIR("??")="^D APDT^IBDFDE7"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO SELAPQ
+8 SET ANS=+Y
SELAPQ QUIT ANS
+1 ;
SCRN ; -- input transform logic for selecting an appointment date/time
+1 IF $GET(IBDF("CLINIC"))=""
KILL X
+2 IF '$DATA(^SC(IBDF("CLINIC"),"S",Y,1))
WRITE $CHAR(7),"?? No appointments that time."
KILL X
+3 QUIT
+4 ;
EXCLUD ; -- select patient(s) to process
+1 SET RESULT=""
+2 SET DIR("?")="Enter the number of the patient to exclude."
+3 SET DIR("??")="^D LIST^IBDFDE6"
+4 SET DIR(0)="FO^1:30"
SET DIR("A")="Exclude Patient"
+5 IF RESULT'=""
SET DIR("A")="Exclude Another Patient"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBQUIT=1
GOTO EXCLUDQ
+8 SET ANS=Y
+9 IF ANS=""
GOTO EXCLUDQ
+10 IF ANS'=+ANS
WRITE !,"You must select a number from the list."
+11 IF ANS=+ANS
IF $DATA(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),ANS))
Begin DoDot:1
+12 SET RESULT=^TMP("IBD-PL",$JOB,IBDF("CLINIC"),ANS)
+13 KILL ^TMP("IBD-PL",$JOB,IBDF("CLINIC"),ANS),^TMP("IBD-PLN",$JOB,IBDF("CLINIC"),$PIECE($GET(^DPT(+RESULT,0)),"^"))
+14 WRITE " ",$PIECE($GET(^DPT(+RESULT,0)),"^")," ","Excluded!"
End DoDot:1
+15 ;
+16 IF '$DATA(^TMP("IBD-PL",$JOB,IBDF("CLINIC")))
WRITE !!,"No patients left"
SET IBQUIT=2
GOTO EXCLUDQ
+17 ;
+18 GOTO EXCLUD
EXCLUDQ QUIT
+1 ;
BLD ; -- Find all appointments for a date
+1 KILL ^TMP("IBD-PL",$JOB),^TMP("IBD-PLN",$JOB)
+2 NEW SC,IBD,IBD1
+3 SET IBD=IBDFDT
SET SC=IBDF("CLINIC")
SET CNT=0
+4 SET IBD1=0
FOR
SET IBD1=$ORDER(^SC(SC,"S",IBD,1,IBD1))
if 'IBD1
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^SC(SC,"S",IBD,1,IBD1,0))
+6 SET SNODE=$GET(^DPT(+NODE,"S",IBD,0))
+7 SET X=$PIECE(SNODE,"^",2)
+8 ;inpatient appointments are okay
IF X'=""
IF "CNAPCA"[X
QUIT
+9 SET (DFN,IBDF("DFN"))=+NODE
+10 SET CNT=CNT+1
+11 SET ^TMP("IBD-PL",$JOB,SC,CNT)=DFN_"^"_IBD_"^"_SNODE
+12 SET ^TMP("IBD-PLN",$JOB,SC,$PIECE(^DPT(DFN,0),"^"))=DFN_"^"_IBD_"^"_SNODE
End DoDot:1
+13 QUIT
+14 ;
LIST ; -- print list of patients
+1 NEW IBD,IBJ,FORM,STATUS
+2 SET IBD=0
FOR
SET IBD=$ORDER(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),IBD))
if 'IBD
QUIT
Begin DoDot:1
+3 SET DFN=+$GET(^TMP("IBD-PL",$JOB,IBDF("CLINIC"),IBD))
SET APPT=$PIECE($GET(^(IBD)),"^",2)
SET SNODE=$PIECE($GET(^(IBD)),"^",3,99)
+4 SET FORM=+$$FINDID^IBDF18C(DFN,APPT,"",1)
SET STATUS="NO FORM PRINTED"
+5 IF FORM
SET Y=$PIECE($GET(^IBD(357.96,+FORM,0)),"^",11)
SET C=$PIECE(^DD(357.96,.11,0),"^",2)
DO Y^DIQ
SET STATUS=Y
+6 WRITE !?2,IBD,?5,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,20),?29,$PIECE($GET(^DPT(DFN,.36)),"^",3),?43,$$FMTE^XLFDT(+APPT),?64,$EXTRACT($GET(STATUS),1,16)
End DoDot:1
+7 QUIT
+8 ;
APDT ; -- list last 30 days appointment dates in clinic
+1 SET (X,Y)=$$FMADD^XLFDT(DT,-60)
SET CNT=0
+2 FOR
SET X=$ORDER(^SC(IBDF("CLINIC"),"S",X))
if 'X!(X>DT)
QUIT
Begin DoDot:1
+3 SET Y=X
SET CNT=CNT+1
+4 IF CNT=1
WRITE !!,"The following are valid Appointment date/times in the past 60 days:"
+5 if (CNT#3=1)
WRITE !,?3,$$FMTE^XLFDT(Y)
+6 if (CNT#3=2)
WRITE ?30,$$FMTE^XLFDT(Y)
+7 if (CNT#3=0)
WRITE ?60,$$FMTE^XLFDT(Y)
End DoDot:1
+8 QUIT
+9 ;
HDR ; -- print Clinic header
+1 WRITE @IOF
+2 WRITE !," Clinic: ",$EXTRACT(CLNAME,1,25)
WRITE ?40," Date: ",$$FMTE^XLFDT(IBDFDT)
+3 SET FORM=$PIECE(CLSETUP,"^",2)
SET IBDFMNME=$PIECE($GET(^IBE(357,+FORM,0)),"^")
+4 ;W ?40,"Form Status: ",$E(IBDFMSTE,1,25)
WRITE !," Basic Form: ",$EXTRACT(IBDFMNME,1,25)
+5 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","=")
+6 QUIT
+7 ;
END KILL I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDA,SDFN
+1 KILL ^TMP("IBD-PL",$JOB),^TMP("IBD-PLN",$JOB),^TMP("IBD-SAVED",$JOB),^TMP("IBD-MORE",$JOB),^TMP("IBD-PLCHK",$JOB),^TMP("IBD-PL4",$JOB),^TMP("IBD-PLB",$JOB)
+2 KILL ^TMP("IBD-ASK",$JOB),^TMP("IBD-LCODE",$JOB),^TMP("IBD-LST",$JOB),^TMP("IBD-LTEXT",$JOB),^TMP("IBD-OBJ",$JOB)
+3 QUIT
