Routine: IBDFREG

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)

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

ERROR ;prints a message

 W !!,"There is no encounter form defined for this clinic that should print",!,"without patient data!",!

ERROR2 ;prints a message

 W !!,"There are no forms defined to print for this clinic!",!

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

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

NOW ;sets IBAPPT to NOW

 N %,%H,%I,X

 D NOW^%DTC

 S IBAPPT=%

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

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

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

IBDFREG.m