Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDF1A

IBDF1A.m

Go to the documentation of this file.
  1. IBDF1A ;ALB/CJM - ENCOUNTER FORM (prints for a single patient);NOV 16,1992
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
  1. MAIN(WITHDATA) ;
  1. ; -- prints encounter forms, either with patient data for a patient
  1. ; with no appointment (in which case it uses time of printing as
  1. ; the appointment time) or without patient data (only if a form
  1. ; is defined for the clinic for such use)
  1. ; $G(WITDATA) if the form should be printed with data
  1. ; 0 if a blank form for use without patient data should be printed
  1. ;
  1. N IBF,FORMS,NODE,IBPM
  1. ;FORMS = list of forms in form^form^... format
  1. ;IBI is a counter used to parse FORMS
  1. ;IBPM=1 if forms defined in print manager should be printed
  1. N IBFLAG
  1. S IBFLAG=1
  1. S WITHDATA=+$G(WITHDATA)
  1. K ^TMP("IB",$J),^TMP("IBDF",$J)
  1. S (IBPM,IBQUIT)=0,DFN=""
  1. D CLINIC G:IBQUIT EXIT
  1. I WITHDATA D G:IBQUIT EXIT
  1. .D PATIENT Q:IBQUIT
  1. .D NOW
  1. .D WHCHFORM
  1. I 'WITHDATA D FORM G:IBQUIT EXIT
  1. D DEVICE G:IBQUIT EXIT
  1. QUEUED ;
  1. ;input - DFN,IBAPPT,IBCLINIC
  1. N IBDEVICE
  1. ;
  1. D DEVICE^IBDFUA(0,.IBDEVICE)
  1. F IBF=1:1 S IBFORM=$P(FORMS,"^",IBF) Q:'IBFORM D DRWFORM^IBDF2A(IBFORM,WITHDATA,.IBDEVICE)
  1. I WITHDATA,IBPM D PRNTOTHR^IBDF1B5(IBCLINIC,IBAPPT,DFN)
  1. EXIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. E D ^%ZISC
  1. D KPRNTVAR^IBDFUA ;kills the screen and graphics parameters
  1. K IBQUIT,IBFORM,IBCLINIC,DFN,IBAPPT,IBTYPE,X,Y,I,^TMP("IB",$J),^TMP("IBDF",$J),^TMP("DFN",$J),^TMP("RPT",$J)
  1. Q
  1. FORM ;gets the type of form to print from the clinic setup - sets FORMS
  1. N SETUP
  1. S SETUP=$O(^SD(409.95,"B",IBCLINIC,"")) I 'SETUP D ERROR S IBQUIT=1 Q
  1. S SETUP=$G(^SD(409.95,SETUP,0)) I SETUP="" D ERROR S IBQUIT=1 Q
  1. S FORMS=$P(SETUP,"^",5) I 'FORMS D ERROR S IBQUIT=1 Q
  1. Q
  1. ERROR ;prints a message
  1. W !!,"There is no encounter form defined for this clinic that should print",!,"without patient data!",!
  1. Q
  1. ERROR2 ;prints a message
  1. W !!,"There are no forms defined to print for this clinic!",!
  1. Q
  1. PATIENT ;gets the patient to print the form for
  1. S DIR(0)="P^2:EM",DIR("A")="PATIENT NAME" D ^DIR K DIR I $D(DIRUT)!(+Y<1)!('(+Y)) S IBQUIT=1 Q
  1. S DFN=+Y
  1. Q
  1. DEVICE ;
  1. I $D(ZTQUEUED) Q
  1. W !,$C(7),"** Encounter Forms require a page size of 80 lines and 132 columns. **"
  1. K %IS,%ZIS,IOP S %ZIS="MQ" D ^%ZIS I POP S IBQUIT=1 Q
  1. I $D(IO("Q")) D
  1. .S ZTRTN="QUEUED^IBDF1A",(ZTSAVE("WITHDATA"),ZTSAVE("IB*"),ZTSAVE("DFN"),ZTSAVE("FORMS"))=""
  1. .S ZTDESC="IBD - PRINT ENCOUNTER FORM" D ^%ZTLOAD
  1. .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. .D HOME^%ZIS S IBQUIT=1 Q
  1. U IO
  1. Q
  1. CLINIC ;asks the user for the clinic
  1. 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
  1. S IBCLINIC=+Y
  1. Q
  1. NOW ;sets IBAPPT to NOW
  1. N %,%H,%I,X
  1. D NOW^%DTC
  1. S IBAPPT=%
  1. Q
  1. WHCHFORM ;
  1. I 'IBCLINIC D ASKFORM Q
  1. 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
  1. S IBPM=0,FORMS=""
  1. I Y=1 D Q:IBQUIT
  1. .D ASKFORM
  1. E I Y=2 S FORMS=$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT),IBPM=1
  1. I '$P(FORMS,"^"),IBPM,'$$IFOTHR^IBDF1B5(IBCLINIC,"FOR EVERY APPOINTMENT"),'$$IFOTHR^IBDF1B5(IBCLINIC,"ONLY FOR EARLIEST APPOINTMENT") D ERROR2 S IBQUIT=1 Q
  1. Q
  1. ASKFORM ;asks to select single form
  1. K DIC S DIC("S")="I '$P(^(0),U,7)",DIC=357,DIC(0)="AEQ",DIC("A")="Enter form to print: "
  1. D ^DIC K DIC I ($D(DTOUT)!$D(DUOUT)!(+Y<0)) S IBQUIT=1 Q
  1. S FORMS=+Y
  1. Q