IBDF1A ;ALB/CJM - ENCOUNTER FORM (prints for a single patient);NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
MAIN(WITHDATA) ;
; -- prints encounter forms, either with patient data for a patient
; with no appointment (in which case it uses time of printing as
; the appointment time) or without patient data (only if a form
; is defined for the clinic for such use)
; $G(WITDATA) if the form should be printed with data
; 0 if a blank form for use without patient data should be printed
;
N IBF,FORMS,NODE,IBPM
;FORMS = list of forms in form^form^... format
;IBI is a counter used to parse FORMS
;IBPM=1 if forms defined in print manager should be printed
N IBFLAG
S IBFLAG=1
S WITHDATA=+$G(WITHDATA)
K ^TMP("IB",$J),^TMP("IBDF",$J)
S (IBPM,IBQUIT)=0,DFN=""
D CLINIC G:IBQUIT EXIT
I WITHDATA D G:IBQUIT EXIT
.D PATIENT Q:IBQUIT
.D NOW
.D WHCHFORM
I 'WITHDATA D FORM G:IBQUIT EXIT
D DEVICE G:IBQUIT EXIT
QUEUED ;
;input - DFN,IBAPPT,IBCLINIC
N IBDEVICE
;
D DEVICE^IBDFUA(0,.IBDEVICE)
F IBF=1:1 S IBFORM=$P(FORMS,"^",IBF) Q:'IBFORM D DRWFORM^IBDF2A(IBFORM,WITHDATA,.IBDEVICE)
I WITHDATA,IBPM D PRNTOTHR^IBDF1B5(IBCLINIC,IBAPPT,DFN)
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
E D ^%ZISC
D KPRNTVAR^IBDFUA ;kills the screen and graphics parameters
K IBQUIT,IBFORM,IBCLINIC,DFN,IBAPPT,IBTYPE,X,Y,I,^TMP("IB",$J),^TMP("IBDF",$J),^TMP("DFN",$J),^TMP("RPT",$J)
Q
FORM ;gets the type of form to print from the clinic setup - sets FORMS
N SETUP
S SETUP=$O(^SD(409.95,"B",IBCLINIC,"")) I 'SETUP D ERROR S IBQUIT=1 Q
S SETUP=$G(^SD(409.95,SETUP,0)) I SETUP="" D ERROR S IBQUIT=1 Q
S FORMS=$P(SETUP,"^",5) I 'FORMS D ERROR S IBQUIT=1 Q
Q
ERROR ;prints a message
W !!,"There is no encounter form defined for this clinic that should print",!,"without patient data!",!
Q
ERROR2 ;prints a message
W !!,"There are no forms defined to print for this clinic!",!
Q
PATIENT ;gets the patient to print the form for
S DIR(0)="P^2:EM",DIR("A")="PATIENT NAME" D ^DIR K DIR I $D(DIRUT)!(+Y<1)!('(+Y)) S IBQUIT=1 Q
S DFN=+Y
Q
DEVICE ;
I $D(ZTQUEUED) Q
W !,$C(7),"** Encounter Forms require a page size of 80 lines and 132 columns. **"
K %IS,%ZIS,IOP S %ZIS="MQ" D ^%ZIS I POP S IBQUIT=1 Q
I $D(IO("Q")) D
.S ZTRTN="QUEUED^IBDF1A",(ZTSAVE("WITHDATA"),ZTSAVE("IB*"),ZTSAVE("DFN"),ZTSAVE("FORMS"))=""
.S ZTDESC="IBD - PRINT ENCOUNTER FORM" D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS S IBQUIT=1 Q
U IO
Q
CLINIC ;asks the user for the clinic
K DA,DIR S DIR(0)="409.95,.01O",DIR("A")="PRINT AN ENCOUNTER FORM FOR WHICH CLINIC? " D ^DIR K DIR,DA I $D(DTOUT)!$D(DUOUT)!(+Y<0)!('(+Y)) S IBQUIT=1 Q
S IBCLINIC=+Y
Q
NOW ;sets IBAPPT to NOW
N %,%H,%I,X
D NOW^%DTC
S IBAPPT=%
Q
WHCHFORM ;
I 'IBCLINIC D ASKFORM Q
K DIR S DIR(0)="S^1:SELECT ANY FORM;2:USE CLINIC SETUP;",DIR("A")="Do you want to Select a form or Use the form(s) defined by the clinic setup?" D ^DIR K DIR I $D(DIRUT)!(+Y<0) S IBQUIT=1 Q
S IBPM=0,FORMS=""
I Y=1 D Q:IBQUIT
.D ASKFORM
E I Y=2 S FORMS=$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT),IBPM=1
I '$P(FORMS,"^"),IBPM,'$$IFOTHR^IBDF1B5(IBCLINIC,"FOR EVERY APPOINTMENT"),'$$IFOTHR^IBDF1B5(IBCLINIC,"ONLY FOR EARLIEST APPOINTMENT") D ERROR2 S IBQUIT=1 Q
Q
ASKFORM ;asks to select single form
K DIC S DIC("S")="I '$P(^(0),U,7)",DIC=357,DIC(0)="AEQ",DIC("A")="Enter form to print: "
D ^DIC K DIC I ($D(DTOUT)!$D(DUOUT)!(+Y<0)) S IBQUIT=1 Q
S FORMS=+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF1A 3568 printed Oct 16, 2024@18:51:48 Page 2
IBDF1A ;ALB/CJM - ENCOUNTER FORM (prints for a single patient);NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
MAIN(WITHDATA) ;
+1 ; -- prints encounter forms, either with patient data for a patient
+2 ; with no appointment (in which case it uses time of printing as
+3 ; the appointment time) or without patient data (only if a form
+4 ; is defined for the clinic for such use)
+5 ; $G(WITDATA) if the form should be printed with data
+6 ; 0 if a blank form for use without patient data should be printed
+7 ;
+8 NEW IBF,FORMS,NODE,IBPM
+9 ;FORMS = list of forms in form^form^... format
+10 ;IBI is a counter used to parse FORMS
+11 ;IBPM=1 if forms defined in print manager should be printed
+12 NEW IBFLAG
+13 SET IBFLAG=1
+14 SET WITHDATA=+$GET(WITHDATA)
+15 KILL ^TMP("IB",$JOB),^TMP("IBDF",$JOB)
+16 SET (IBPM,IBQUIT)=0
SET DFN=""
+17 DO CLINIC
if IBQUIT
GOTO EXIT
+18 IF WITHDATA
Begin DoDot:1
+19 DO PATIENT
if IBQUIT
QUIT
+20 DO NOW
+21 DO WHCHFORM
End DoDot:1
if IBQUIT
GOTO EXIT
+22 IF 'WITHDATA
DO FORM
if IBQUIT
GOTO EXIT
+23 DO DEVICE
if IBQUIT
GOTO EXIT
QUEUED ;
+1 ;input - DFN,IBAPPT,IBCLINIC
+2 NEW IBDEVICE
+3 ;
+4 DO DEVICE^IBDFUA(0,.IBDEVICE)
+5 FOR IBF=1:1
SET IBFORM=$PIECE(FORMS,"^",IBF)
if 'IBFORM
QUIT
DO DRWFORM^IBDF2A(IBFORM,WITHDATA,.IBDEVICE)
+6 IF WITHDATA
IF IBPM
DO PRNTOTHR^IBDF1B5(IBCLINIC,IBAPPT,DFN)
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$TEST
DO ^%ZISC
+3 ;kills the screen and graphics parameters
DO KPRNTVAR^IBDFUA
+4 KILL IBQUIT,IBFORM,IBCLINIC,DFN,IBAPPT,IBTYPE,X,Y,I,^TMP("IB",$JOB),^TMP("IBDF",$JOB),^TMP("DFN",$JOB),^TMP("RPT",$JOB)
+5 QUIT
FORM ;gets the type of form to print from the clinic setup - sets FORMS
+1 NEW SETUP
+2 SET SETUP=$ORDER(^SD(409.95,"B",IBCLINIC,""))
IF 'SETUP
DO ERROR
SET IBQUIT=1
QUIT
+3 SET SETUP=$GET(^SD(409.95,SETUP,0))
IF SETUP=""
DO ERROR
SET IBQUIT=1
QUIT
+4 SET FORMS=$PIECE(SETUP,"^",5)
IF 'FORMS
DO ERROR
SET IBQUIT=1
QUIT
+5 QUIT
ERROR ;prints a message
+1 WRITE !!,"There is no encounter form defined for this clinic that should print",!,"without patient data!",!
+2 QUIT
ERROR2 ;prints a message
+1 WRITE !!,"There are no forms defined to print for this clinic!",!
+2 QUIT
PATIENT ;gets the patient to print the form for
+1 SET DIR(0)="P^2:EM"
SET DIR("A")="PATIENT NAME"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(+Y<1)!('(+Y))
SET IBQUIT=1
QUIT
+2 SET DFN=+Y
+3 QUIT
DEVICE ;
+1 IF $DATA(ZTQUEUED)
QUIT
+2 WRITE !,$CHAR(7),"** Encounter Forms require a page size of 80 lines and 132 columns. **"
+3 KILL %IS,%ZIS,IOP
SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IBQUIT=1
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="QUEUED^IBDF1A"
SET (ZTSAVE("WITHDATA"),ZTSAVE("IB*"),ZTSAVE("DFN"),ZTSAVE("FORMS"))=""
+6 SET ZTDESC="IBD - PRINT ENCOUNTER FORM"
DO ^%ZTLOAD
+7 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+8 DO HOME^%ZIS
SET IBQUIT=1
QUIT
End DoDot:1
+9 USE IO
+10 QUIT
CLINIC ;asks the user for the clinic
+1 KILL DA,DIR
SET DIR(0)="409.95,.01O"
SET DIR("A")="PRINT AN ENCOUNTER FORM FOR WHICH CLINIC? "
DO ^DIR
KILL DIR,DA
IF $DATA(DTOUT)!$DATA(DUOUT)!(+Y<0)!('(+Y))
SET IBQUIT=1
QUIT
+2 SET IBCLINIC=+Y
+3 QUIT
NOW ;sets IBAPPT to NOW
+1 NEW %,%H,%I,X
+2 DO NOW^%DTC
+3 SET IBAPPT=%
+4 QUIT
WHCHFORM ;
+1 IF 'IBCLINIC
DO ASKFORM
QUIT
+2 KILL DIR
SET DIR(0)="S^1:SELECT ANY FORM;2:USE CLINIC SETUP;"
SET DIR("A")="Do you want to Select a form or Use the form(s) defined by the clinic setup?"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(+Y<0)
SET IBQUIT=1
QUIT
+3 SET IBPM=0
SET FORMS=""
+4 IF Y=1
Begin DoDot:1
+5 DO ASKFORM
End DoDot:1
if IBQUIT
QUIT
+6 IF '$TEST
IF Y=2
SET FORMS=$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT)
SET IBPM=1
+7 IF '$PIECE(FORMS,"^")
IF IBPM
IF '$$IFOTHR^IBDF1B5(IBCLINIC,"FOR EVERY APPOINTMENT")
IF '$$IFOTHR^IBDF1B5(IBCLINIC,"ONLY FOR EARLIEST APPOINTMENT")
DO ERROR2
SET IBQUIT=1
QUIT
+8 QUIT
ASKFORM ;asks to select single form
+1 KILL DIC
SET DIC("S")="I '$P(^(0),U,7)"
SET DIC=357
SET DIC(0)="AEQ"
SET DIC("A")="Enter form to print: "
+2 DO ^DIC
KILL DIC
IF ($DATA(DTOUT)!$DATA(DUOUT)!(+Y<0))
SET IBQUIT=1
QUIT
+3 SET FORMS=+Y
+4 QUIT
