IBDFREG ;ALB/CJM - ENCOUNTER FORM (prints for a single patient);NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;;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
D CLINIC G:IBQUIT EXIT
I WITHDATA D G:IBQUIT EXIT
.D NOW
.D WHCHFORM
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,IBAPPT,IBTYPE,X,Y,I,^TMP("IB",$J),^TMP("IBDF",$J),^TMP("RPT",$J),^TMP("DFN",$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
DEVICE ;
; -- always ask with param as default
S %ZIS("A")="Select Encounter Form PRINTER: "
S %ZIS("B")=$P($G(^DG(43,1,0)),"^",48) S %ZIS="MQN",%ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-""" D ^%ZIS
I POP S IBQUIT=1 Q
S IBDFRION=ION
;
; -- ask only if parameter not defined
;I $P($G(^DG(43,1,0)),"^",48)="" S %ZIS="MQN" D ^%ZIS Q:POP S IBDFRION=ION
;
I IO=IO(0)!($E(IOST,1,2)["C-") W !,"Queuing to a CRT not allowed!" S IBQUIT=1 Q
S ZTRTN="QUEUED^IBDF1A",(ZTSAVE("WITHDATA"),ZTSAVE("IB*"),ZTSAVE("DFN"),ZTSAVE("FORMS"))="",ZTDTH=$H
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
Q
CLINIC ;asks the user for the clinic
K DIR S DIR(0)="409.95,.01O",DIR("A")="PRINT AN ENCOUNTER FORM FOR WHICH CLINIC? " D ^DIR K DIR 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 ;
S IBPM=0,FORMS=""
S 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
;
WI(DFN,IBCLINIC,IBAPPT) ; -- procedure
; -- print encounter form for walk-ins (not tested)
N DIR,IBQUIT,IBF,FORMS,NODE,IBPM,IBDFWI,WITHDATA
S IBQUIT=0
G:'$G(DFN) WIQ
G:'$G(IBAPPT) WIQ
;
S DIR(0)="Y",DIR("A")="DO YOU WANT TO PRINT AN ENCOUNTER FORM NOW"
W ! D ^DIR K DIR G WIQ:$D(DIRUT)!(Y=0)
;
I '$G(IBCLINIC) D CLINIC G:IBQUIT WIQ
;
S (IBDFWI,WITHDATA)=1
K ^TMP("IB",$J),^TMP("IBDF",$J)
S (IBPM,IBQUIT)=0
D WHCHFORM
D DEVICE G:IBQUIT WIQ ;automatically queues form
D QUEUED
WIQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFREG 3686 printed Nov 22, 2024@18:03:27 Page 2
IBDFREG ;ALB/CJM - ENCOUNTER FORM (prints for a single patient);NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;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
+17 DO CLINIC
if IBQUIT
GOTO EXIT
+18 IF WITHDATA
Begin DoDot:1
+19 DO NOW
+20 DO WHCHFORM
End DoDot:1
if IBQUIT
GOTO EXIT
+21 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,IBAPPT,IBTYPE,X,Y,I,^TMP("IB",$JOB),^TMP("IBDF",$JOB),^TMP("RPT",$JOB),^TMP("DFN",$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
DEVICE ;
+1 ; -- always ask with param as default
+2 SET %ZIS("A")="Select Encounter Form PRINTER: "
+3 SET %ZIS("B")=$PIECE($GET(^DG(43,1,0)),"^",48)
SET %ZIS="MQN"
SET %ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-"""
DO ^%ZIS
+4 IF POP
SET IBQUIT=1
QUIT
+5 SET IBDFRION=ION
+6 ;
+7 ; -- ask only if parameter not defined
+8 ;I $P($G(^DG(43,1,0)),"^",48)="" S %ZIS="MQN" D ^%ZIS Q:POP S IBDFRION=ION
+9 ;
+10 IF IO=IO(0)!($EXTRACT(IOST,1,2)["C-")
WRITE !,"Queuing to a CRT not allowed!"
SET IBQUIT=1
QUIT
+11 SET ZTRTN="QUEUED^IBDF1A"
SET (ZTSAVE("WITHDATA"),ZTSAVE("IB*"),ZTSAVE("DFN"),ZTSAVE("FORMS"))=""
SET ZTDTH=$HOROLOG
+12 SET ZTDESC="IBD - PRINT ENCOUNTER FORM"
DO ^%ZTLOAD
+13 ;W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+14 DO HOME^%ZIS
SET IBQUIT=1
QUIT
+15 QUIT
CLINIC ;asks the user for the clinic
+1 KILL DIR
SET DIR(0)="409.95,.01O"
SET DIR("A")="PRINT AN ENCOUNTER FORM FOR WHICH CLINIC? "
DO ^DIR
KILL DIR
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 SET IBPM=0
SET FORMS=""
+2 SET Y=2
SET FORMS=$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT)
SET IBPM=1
+3 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
+4 QUIT
+5 ;
WI(DFN,IBCLINIC,IBAPPT) ; -- procedure
+1 ; -- print encounter form for walk-ins (not tested)
+2 NEW DIR,IBQUIT,IBF,FORMS,NODE,IBPM,IBDFWI,WITHDATA
+3 SET IBQUIT=0
+4 if '$GET(DFN)
GOTO WIQ
+5 if '$GET(IBAPPT)
GOTO WIQ
+6 ;
+7 SET DIR(0)="Y"
SET DIR("A")="DO YOU WANT TO PRINT AN ENCOUNTER FORM NOW"
+8 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)!(Y=0)
GOTO WIQ
+9 ;
+10 IF '$GET(IBCLINIC)
DO CLINIC
if IBQUIT
GOTO WIQ
+11 ;
+12 SET (IBDFWI,WITHDATA)=1
+13 KILL ^TMP("IB",$JOB),^TMP("IBDF",$JOB)
+14 SET (IBPM,IBQUIT)=0
+15 DO WHCHFORM
+16 ;automatically queues form
DO DEVICE
if IBQUIT
GOTO WIQ
+17 DO QUEUED
WIQ QUIT
