- 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 Jan 18, 2025@03:52:13 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