IBDF1B ;ALB/CJM - ENCOUNTER FORM (printing forms for appointments); 3/1/93
;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
;
;IBSRT=1 for sort by clinic/patient name
;IBSRT=2 for sort by terminal digits
;IBSRT=3 for sort by clinic/terminal digits
;
;SELECTBY="P" if user wants to select appts by patient
;SELECTBY="C" if user wants to select appts by division/clinic
;
;IBDT=date for appointments
;IBREPRNT'="" if this is a reprint of a previous job - then it's either equal to clinic name or 1st 4 terminal digits
;IBSTRTDV is the division to start from in the case of a reprint
;IBADDONS=1 if user wants to do add-ons only, 0 otherwise
;
EN ;
N IBREPRNT,SELECTBY,IBDT,IBSRT,IBADDONS,IBSTRTDV,QUIT,X
S (IBSTRTDV,IBREPRNT)="",(QUIT,IBADDONS)=0
;
;set the error trap so workspace in ^TMP is erased in case of abnormal termination of the print job
S X="ERRORTRP^IBDF1B",@^%ZOSF("TRAP")
;
K ^TMP("IBDF",$J),^TMP("IB",$J)
D HOME^%ZIS
D
.D SELECTBY Q:QUIT S:SELECTBY="P" IBSRT=1 ;if selecting by patient then sort by clinic/patient rather than by terminal digits
.D:SELECTBY="C" SORTBY^IBDF1BA Q:QUIT
.D APPTDATE Q:QUIT
.;now allow user to makes selections, whether by patient or clinic
.D @SELECTBY
.;
.;if nothing selected exit
.Q:'$D(^TMP("IBDF",$J))
.;
.;since selecting by entire clinics, may want to do add-ons only or restart the job
.I SELECTBY="C" D Q:QUIT
..D ADDONS Q:QUIT
..D REPRINT Q:QUIT
;
;
;if nothing selected exit
END G:('$D(^TMP("IBDF",$J)))!QUIT EXIT
W !,$C(7),"** Encounter Forms require a page size of 80 lines and 132 columns. **"
K %IS,%ZIS,IOP S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="^IBDF1B1",ZTDESC="IBDF Encounter Forms",ZTSAVE("^TMP(""IBDF"",$J,")="",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS G EXIT
U IO
D ^IBDF1B1
EXIT ;
K ^TMP("IBDF",$J),^TMP("IB",$J),^TMP("RPT",$J),^TMP("DFN",$J)
I $D(ZTQUEUED) S ZTREQ="@" Q
K DTOUT,DUOUT,DIRUT,DIROUT,X,Y,D0,DA,IBTYPE
D ^%ZISC
Q
;
REPRINT ;for prior job that partially completed?
;IBSTRTDV is the division to restart from
;IBREPRNT is the clinic or first 4 of terminal digits to restart from
S DIR(0)="Y",DIR("A")="IS THIS A REPRINT OF A PREVIOUS RUN"
S DIR("B")="NO",DIR("?")="ANSWER YES IF SOME OF THE FORMS WERE ALREADY PRINTED BY A PREVIOUS JOB THAT DID NOT SUCCESSFULLY COMPLETE"
D ^DIR K DIR I $D(DIRUT)!(Y=-1) S QUIT=1 Q
I Y D I IBREPRNT="" S QUIT=1 Q
.I IBSRT=2 D ;sorting by division/terminal digit
..;ask which division to restart from
..S IBSTRTDV=$$STARTDIV^IBDF1BA I IBSTRTDV="" S IBREPRNT="" Q
..;ask which terminal digit to restart from
..D TERMSTRT^IBDF1BA Q:IBREPRNT=""
.I (IBSRT=1)!(IBSRT=3) D CLNCSTRT^IBDF1BA ;sorting by division/clinic, ask which clinic to restart from
Q
ADDONS ;add-ons only?
S DIR(0)="Y",DIR("A")="WANT TO PRINT ADD-ONS ONLY"
S DIR("B")="NO",DIR("?")="ANSWER YES TO ONLY PRINT ADD-ONS"
D ^DIR K DIR I $D(DIRUT)!(Y=-1) S QUIT=1 Q
S IBADDONS=Y
Q
SELECTBY ;select by patient or clinic?
W !,"Do you want to print forms for a particular patient or for entire clinics?",!
K DIR S DIR("B")="Clinic",DIR(0)="SO^P:Patient;C:Clinic",DIR("A")="Select Appointment by"
D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
S SELECTBY=Y
Q
;
P ;print by patient - get patient then appointment(s) for date
N IBTMP,IBNM,DFN
;IBNM=patient name, IBTMP=array to store patient's appts
F K DIC S DIC="^DPT(",DIC(0)="AEQM" D ^DIC K DIC Q:Y<0 S DFN=+Y,IBNM=$P(Y,"^",2) D SEARCH^IBDF1BA,DISP^IBDF1BA
Q
;
C ;print all appointments for a clinic - find division then clinic, print all/some clinics for all/some divisions
;
N GROUPS,IEN
;
;get the PRINT MANAGER CLINIC GROUPS
S GROUPS=""
K DIR
S DIR(0)="PAO^357.99:AEMQ",DIR("A")="Select Print Manager Clinic Group:",DIR("?")="You can choose from previously defined clinic groups."
F D ^DIR Q:((+Y<0)!$D(DIRUT)) S GROUPS(+Y)="",DIR("A")="Select another Print Manager Clinic Group:"
S GROUPS=0 F S GROUPS=$O(GROUPS(GROUPS)) Q:'GROUPS D
.S IEN=0 F S IEN=$O(^IBD(357.99,GROUPS,10,IEN)) Q:'IEN S IBCLN=+$G(^IBD(357.99,GROUPS,10,IEN,0)) S:IBCLN ^TMP("IBDF",$J,"C",IBCLN)=""
.S IEN=0 F S IEN=$O(^IBD(357.99,GROUPS,11,IEN)) Q:'IEN S IBDIV=+$G(^IBD(357.99,GROUPS,11,IEN,0)) S:IBDIV ^TMP("IBDF",$J,"D",IBDIV)=""
K DIR
G:$O(GROUPS(0)) ENDC
;
;now ask divisions and clinics
W !!,"Now you can select individual divisions and clinics."
;D ASK2^IBODIV G:$D(VAUTD)<11&(VAUTD=0) ENDC
S VAUTD=1 I $P($G(^DG(43,1,"GL")),"^",2) D DIVISION^VAUTOMA I Y=-1 G ENDC
S DIC("S")="I $P(^SC(+Y,0),U,3)=""C"",$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD($O(^DG(40.8,0)))):1,1:0)"
W !!,"If you want to print forms for all clinics in the divisions you have",!,"chosen (for those clinics with forms defined) then select ALL."
W !!,"Otherwise, select the particular clinics you want.",!
S DIC="^SC(",VAUTVB="VAUTC",VAUTNI=2,VAUTSTR="clinic" D FIRST^VAUTOMA K DIC G:$D(VAUTC)<11&(VAUTC=0) ENDC
I VAUTC,VAUTD S ^TMP("IBDF",$J,"D","ALL")=""
I VAUTC,'VAUTD S IBDIV="" F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" S ^TMP("IBDF",$J,"D",IBDIV)=""
I 'VAUTC S IBCLN="" F S IBCLN=$O(VAUTC(IBCLN)) Q:IBCLN="" S ^TMP("IBDF",$J,"C",IBCLN)=""
ENDC K VAUTNI,VAUTD,VAUTC,VAUTVB,VAUTSTR,IBDIV,IBCLN,DIC
Q
;
APPTDATE ;print forms for appointments on what date?
K DIR S DIR(0)="D^::AEX",DIR("B")="TODAY",DIR("A")="Appointment Date to Print Forms For"
S DIR("?",1)="Only Clinics and Patients with Appointments on this Date will be allowed."
S DIR("?")="Nothing will print for Appointments in Clinics/Divisions with no forms defined."
D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
S IBDT=Y
Q
;
ERRORTRP ;the error trap
K ^TMP("IBDF",$J),^TMP("IB",$J)
D @^%ZOSF("ERRTN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF1B 5914 printed Dec 13, 2024@02:51:03 Page 2
IBDF1B ;ALB/CJM - ENCOUNTER FORM (printing forms for appointments); 3/1/93
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
+2 ;
+3 ;IBSRT=1 for sort by clinic/patient name
+4 ;IBSRT=2 for sort by terminal digits
+5 ;IBSRT=3 for sort by clinic/terminal digits
+6 ;
+7 ;SELECTBY="P" if user wants to select appts by patient
+8 ;SELECTBY="C" if user wants to select appts by division/clinic
+9 ;
+10 ;IBDT=date for appointments
+11 ;IBREPRNT'="" if this is a reprint of a previous job - then it's either equal to clinic name or 1st 4 terminal digits
+12 ;IBSTRTDV is the division to start from in the case of a reprint
+13 ;IBADDONS=1 if user wants to do add-ons only, 0 otherwise
+14 ;
EN ;
+1 NEW IBREPRNT,SELECTBY,IBDT,IBSRT,IBADDONS,IBSTRTDV,QUIT,X
+2 SET (IBSTRTDV,IBREPRNT)=""
SET (QUIT,IBADDONS)=0
+3 ;
+4 ;set the error trap so workspace in ^TMP is erased in case of abnormal termination of the print job
+5 SET X="ERRORTRP^IBDF1B"
SET @^%ZOSF("TRAP")
+6 ;
+7 KILL ^TMP("IBDF",$JOB),^TMP("IB",$JOB)
+8 DO HOME^%ZIS
+9 Begin DoDot:1
+10 ;if selecting by patient then sort by clinic/patient rather than by terminal digits
DO SELECTBY
if QUIT
QUIT
if SELECTBY="P"
SET IBSRT=1
+11 if SELECTBY="C"
DO SORTBY^IBDF1BA
if QUIT
QUIT
+12 DO APPTDATE
if QUIT
QUIT
+13 ;now allow user to makes selections, whether by patient or clinic
+14 DO @SELECTBY
+15 ;
+16 ;if nothing selected exit
+17 if '$DATA(^TMP("IBDF",$JOB))
QUIT
+18 ;
+19 ;since selecting by entire clinics, may want to do add-ons only or restart the job
+20 IF SELECTBY="C"
Begin DoDot:2
+21 DO ADDONS
if QUIT
QUIT
+22 DO REPRINT
if QUIT
QUIT
End DoDot:2
if QUIT
QUIT
End DoDot:1
+23 ;
+24 ;
+25 ;if nothing selected exit
END if ('$DATA(^TMP("IBDF",$JOB)))!QUIT
GOTO EXIT
+1 WRITE !,$CHAR(7),"** Encounter Forms require a page size of 80 lines and 132 columns. **"
+2 KILL %IS,%ZIS,IOP
SET %ZIS="QM"
SET %ZIS("A")="OUTPUT DEVICE: "
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="^IBDF1B1"
SET ZTDESC="IBDF Encounter Forms"
SET ZTSAVE("^TMP(""IBDF"",$J,")=""
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q")
WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
DO HOME^%ZIS
GOTO EXIT
+4 USE IO
+5 DO ^IBDF1B1
EXIT ;
+1 KILL ^TMP("IBDF",$JOB),^TMP("IB",$JOB),^TMP("RPT",$JOB),^TMP("DFN",$JOB)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 KILL DTOUT,DUOUT,DIRUT,DIROUT,X,Y,D0,DA,IBTYPE
+4 DO ^%ZISC
+5 QUIT
+6 ;
REPRINT ;for prior job that partially completed?
+1 ;IBSTRTDV is the division to restart from
+2 ;IBREPRNT is the clinic or first 4 of terminal digits to restart from
+3 SET DIR(0)="Y"
SET DIR("A")="IS THIS A REPRINT OF A PREVIOUS RUN"
+4 SET DIR("B")="NO"
SET DIR("?")="ANSWER YES IF SOME OF THE FORMS WERE ALREADY PRINTED BY A PREVIOUS JOB THAT DID NOT SUCCESSFULLY COMPLETE"
+5 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=-1)
SET QUIT=1
QUIT
+6 IF Y
Begin DoDot:1
+7 ;sorting by division/terminal digit
IF IBSRT=2
Begin DoDot:2
+8 ;ask which division to restart from
+9 SET IBSTRTDV=$$STARTDIV^IBDF1BA
IF IBSTRTDV=""
SET IBREPRNT=""
QUIT
+10 ;ask which terminal digit to restart from
+11 DO TERMSTRT^IBDF1BA
if IBREPRNT=""
QUIT
End DoDot:2
+12 ;sorting by division/clinic, ask which clinic to restart from
IF (IBSRT=1)!(IBSRT=3)
DO CLNCSTRT^IBDF1BA
End DoDot:1
IF IBREPRNT=""
SET QUIT=1
QUIT
+13 QUIT
ADDONS ;add-ons only?
+1 SET DIR(0)="Y"
SET DIR("A")="WANT TO PRINT ADD-ONS ONLY"
+2 SET DIR("B")="NO"
SET DIR("?")="ANSWER YES TO ONLY PRINT ADD-ONS"
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=-1)
SET QUIT=1
QUIT
+4 SET IBADDONS=Y
+5 QUIT
SELECTBY ;select by patient or clinic?
+1 WRITE !,"Do you want to print forms for a particular patient or for entire clinics?",!
+2 KILL DIR
SET DIR("B")="Clinic"
SET DIR(0)="SO^P:Patient;C:Clinic"
SET DIR("A")="Select Appointment by"
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET QUIT=1
QUIT
+4 SET SELECTBY=Y
+5 QUIT
+6 ;
P ;print by patient - get patient then appointment(s) for date
+1 NEW IBTMP,IBNM,DFN
+2 ;IBNM=patient name, IBTMP=array to store patient's appts
+3 FOR
KILL DIC
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
if Y<0
QUIT
SET DFN=+Y
SET IBNM=$PIECE(Y,"^",2)
DO SEARCH^IBDF1BA
DO DISP^IBDF1BA
+4 QUIT
+5 ;
C ;print all appointments for a clinic - find division then clinic, print all/some clinics for all/some divisions
+1 ;
+2 NEW GROUPS,IEN
+3 ;
+4 ;get the PRINT MANAGER CLINIC GROUPS
+5 SET GROUPS=""
+6 KILL DIR
+7 SET DIR(0)="PAO^357.99:AEMQ"
SET DIR("A")="Select Print Manager Clinic Group:"
SET DIR("?")="You can choose from previously defined clinic groups."
+8 FOR
DO ^DIR
if ((+Y<0)!$DATA(DIRUT))
QUIT
SET GROUPS(+Y)=""
SET DIR("A")="Select another Print Manager Clinic Group:"
+9 SET GROUPS=0
FOR
SET GROUPS=$ORDER(GROUPS(GROUPS))
if 'GROUPS
QUIT
Begin DoDot:1
+10 SET IEN=0
FOR
SET IEN=$ORDER(^IBD(357.99,GROUPS,10,IEN))
if 'IEN
QUIT
SET IBCLN=+$GET(^IBD(357.99,GROUPS,10,IEN,0))
if IBCLN
SET ^TMP("IBDF",$JOB,"C",IBCLN)=""
+11 SET IEN=0
FOR
SET IEN=$ORDER(^IBD(357.99,GROUPS,11,IEN))
if 'IEN
QUIT
SET IBDIV=+$GET(^IBD(357.99,GROUPS,11,IEN,0))
if IBDIV
SET ^TMP("IBDF",$JOB,"D",IBDIV)=""
End DoDot:1
+12 KILL DIR
+13 if $ORDER(GROUPS(0))
GOTO ENDC
+14 ;
+15 ;now ask divisions and clinics
+16 WRITE !!,"Now you can select individual divisions and clinics."
+17 ;D ASK2^IBODIV G:$D(VAUTD)<11&(VAUTD=0) ENDC
+18 SET VAUTD=1
IF $PIECE($GET(^DG(43,1,"GL")),"^",2)
DO DIVISION^VAUTOMA
IF Y=-1
GOTO ENDC
+19 SET DIC("S")="I $P(^SC(+Y,0),U,3)=""C"",$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD($O(^DG(40.8,0)))):1,1:0)"
+20 WRITE !!,"If you want to print forms for all clinics in the divisions you have",!,"chosen (for those clinics with forms defined) then select ALL."
+21 WRITE !!,"Otherwise, select the particular clinics you want.",!
+22 SET DIC="^SC("
SET VAUTVB="VAUTC"
SET VAUTNI=2
SET VAUTSTR="clinic"
DO FIRST^VAUTOMA
KILL DIC
if $DATA(VAUTC)<11&(VAUTC=0)
GOTO ENDC
+23 IF VAUTC
IF VAUTD
SET ^TMP("IBDF",$JOB,"D","ALL")=""
+24 IF VAUTC
IF 'VAUTD
SET IBDIV=""
FOR
SET IBDIV=$ORDER(VAUTD(IBDIV))
if IBDIV=""
QUIT
SET ^TMP("IBDF",$JOB,"D",IBDIV)=""
+25 IF 'VAUTC
SET IBCLN=""
FOR
SET IBCLN=$ORDER(VAUTC(IBCLN))
if IBCLN=""
QUIT
SET ^TMP("IBDF",$JOB,"C",IBCLN)=""
ENDC KILL VAUTNI,VAUTD,VAUTC,VAUTVB,VAUTSTR,IBDIV,IBCLN,DIC
+1 QUIT
+2 ;
APPTDATE ;print forms for appointments on what date?
+1 KILL DIR
SET DIR(0)="D^::AEX"
SET DIR("B")="TODAY"
SET DIR("A")="Appointment Date to Print Forms For"
+2 SET DIR("?",1)="Only Clinics and Patients with Appointments on this Date will be allowed."
+3 SET DIR("?")="Nothing will print for Appointments in Clinics/Divisions with no forms defined."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET QUIT=1
QUIT
+5 SET IBDT=Y
+6 QUIT
+7 ;
ERRORTRP ;the error trap
+1 KILL ^TMP("IBDF",$JOB),^TMP("IB",$JOB)
+2 DO @^%ZOSF("ERRTN")
+3 QUIT
