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

IBDF15A.m

Go to the documentation of this file. 
  1. IBDF15A ;ALB/CJM - AICS FORM USE BY DIVISION/CLINIC ; JUL 20,1993
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
  1.  ;
  1.  ; -- prints for each encounter form the clinics using it
  1.  ;
  1. PRINT ; -- Main print driver
  1.  W:$E(IOST,1,2)="C-" @IOF
  1.  S FORMNAM="" F  S FORMNAM=$O(^IBE(357,"B",FORMNAM)) Q:FORMNAM=""  S FORM=$O(^IBE(357,"B",FORMNAM,0)) Q:'FORM  D  Q:IBQUIT
  1.  .Q:$P($G(^IBE(357,FORM,0)),"^",7)  ;exclude toolkit forms
  1.  .D CLINIC(FORM,FORMNAM)
  1.  D LIST
  1.  I $E(IOST,1,2)="C-",'IBQUIT D PAUSE
  1.  Q
  1.  ;
  1. CLINIC(FORM,FORMNAM) ;
  1.  ; -- finds the list of clinics using FORM
  1.  ;    ^TMP($J,"IBDCS",0) is number of clinics found
  1.  ;    ^TMP($J,"IBDCS",divname, div pointer, form name, form pointer,
  1.  ;                 clinic name)=clinic pointer := is list of clinics
  1.  ;
  1.  N CLINIC,SETUP,IDX,CLNAME,DIVIS,DIVNAM,CNT
  1.  F IDX="C","D","E","F","G","H","I","J" D
  1.  .S SETUP="" F  S SETUP=$O(^SD(409.95,IDX,FORM,SETUP)) Q:'SETUP  D
  1.  ..S CLINIC=$P($G(^SD(409.95,SETUP,0)),"^",1)
  1.  ..Q:'CLINIC
  1.  ..S CLNAME=$P($G(^SC(CLINIC,0)),"^",1)
  1.  ..Q:CLNAME=""
  1.  ..S DIVIS=$P($G(^SC(CLINIC,0)),"^",15)
  1.  ..I DIVIS="" S DIVIS=$S(MULTI=0:$$PRIM^VASITE,1:"Unknown")
  1.  ..S DIVNAM=$P($G(^DG(40.8,+DIVIS,0)),"^")
  1.  ..S:DIVNAM="" DIVNAM="Unknown"
  1.  ..S CNT=$G(CNT)+1
  1.  ..S ^TMP($J,"IBDCS",DIVNAM,+$G(DIVIS),FORMNAM,FORM,CLNAME)=CLINIC_"^"_IDX
  1.  ..S ^TMP($J,"IBDCS",DIVNAM,+$G(DIVIS))=$G(^TMP($J,"IBDCS",DIVNAM,+$G(DIVIS)))+1
  1.  S:$G(CNT)<1 ^TMP($J,"IBDCN",FORMNAM,FORM)="" ;forms not in use
  1.  Q
  1.  ;
  1. LIST ; -- lists the clinics using FORM
  1.  N DIVNAM,DIVIS,FORMNAM,FORM,CLNAME,CLINIC,NEWDIV,IBDONE,IDX
  1.  ;
  1.  ; -- list forms not in use
  1.  S DIVNAM="",NEWDIV=0
  1.  F  S DIVNAM=$O(^TMP($J,"IBDCS",DIVNAM)) Q:DIVNAM=""!(IBQUIT)  S DIVIS=+$O(^TMP($J,"IBDCS",DIVNAM,"")) I VAUTD=1!($D(VAUTD(DIVIS))) D
  1.  .;
  1.  .S NEWDIV=1
  1.  .K IBDONE
  1.  .S FORMNAM=""
  1.  .F  S FORMNAM=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM)) Q:FORMNAM=""!(IBQUIT)  S FORM=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,0)) D
  1.  ..;
  1.  ..S CLNAME=""
  1.  ..F  S CLNAME=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,FORM,CLNAME)) Q:CLNAME=""!(IBQUIT)  S CLINIC=+^(CLNAME),IDX=$P(^(CLNAME),"^",2) I '$D(IBDONE(FORM)) W ! D LINEONE,ALL(FORMNAM,CLNAME,DIVNAM)
  1.  ;
  1.  ; -- list forms not in use
  1.  S FORMNAM="",NEWDIV=1,DIVNAM="FORMS NOT IN USE"
  1.  F  S FORMNAM=$O(^TMP($J,"IBDCN",FORMNAM)) Q:FORMNAM=""!(IBQUIT)  S FORM=$O(^TMP($J,"IBDCN",FORMNAM,0)) D LINETWO
  1.  Q
  1.  ;
  1. LINEONE ; -- print on report header, lines, etc.
  1.  ;
  1.  I NEWDIV D HEADER Q:IBQUIT  W !,?10,"Division: ",DIVNAM S NEWDIV=0
  1.  I $Y>(IOSL-3) D HEADER Q:IBQUIT
  1.  W !,FORMNAM,?32,$E(CLNAME,1,25),?59,$E(DIVNAM,1,20),?81,$$TYPE(IDX)
  1.  I '$$ACLN^IBDFCNOF(CLINIC) W ?100,"  (Clinic Currently Inactive)"
  1.  S IBDONE(FORM)=""
  1.  Q
  1.  ;
  1. LINETWO ; -- print lines for forms not in use
  1.  I NEWDIV D HEADER Q:IBQUIT  S NEWDIV=0
  1.  I $Y>(IOSL-3) D HEADER Q:IBQUIT
  1.  W !,FORMNAM,?32,"** NOT IN USE **"
  1.  Q
  1.  ;
  1. LINETHR ; -- print lines for clinics in other divisions
  1.  I $Y>(IOSL-3) D HEADER Q:IBQUIT
  1.  W !,?32,CLNAME,?59,$E(DIVNAM,1,20),?81,$$TYPE(IDX)
  1.  I '$$ACLN^IBDFCNOF(CLINIC) W ?100,"  (Clinic Currently Inactive)"
  1.  Q
  1.  ;
  1. ALL(FORMNAM,CL1,DV1) ;
  1.  ; -- find all clinics using for irregardless of division
  1.  ;    stored in ^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,FORM,CLNAME)
  1.  ;
  1.  N FORM,CLNAME,DIVNAM,DIVIS
  1.  S DIVNAM=""
  1.  F  S DIVNAM=$O(^TMP($J,"IBDCS",DIVNAM)) Q:DIVNAM=""!(IBQUIT)  S DIVIS=+$O(^TMP($J,"IBDCS",DIVNAM,"")) I VAUTD=1!($D(VAUTD(DIVIS))) D
  1.  .S FORM=+$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,0))
  1.  .S CLNAME="" F  S CLNAME=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,FORM,CLNAME)) Q:CLNAME=""!(IBQUIT)  S CLINIC=+^(CLNAME) D
  1.  ..Q:CL1=CLNAME&(DV1=DIVNAM)
  1.  ..D LINETHR
  1.  Q
  1.  ;
  1.  ;S FORM=$O(^TMP($J,"IBDCL",FORMNAM,0))
  1.  ;S CLNAME="" F  S CLNAME=$O(^TMP($J,"IBDCL",FORMNAM,FORM,CLNAME)) Q:CLNAME=""!(IBQUIT)  D
  1.  ;.S DIVNAM="" F  S DIVNAM=$O(^TMP($J,"IBDCL",FORMNAM,FORM,CLNAME,DIVNAM)) Q:DIVNAM=""!(IBQUIT)  D
  1.  ;..Q:CL1=CLNAME&(DV1=DIVNAM)
  1.  ;..D LINETHR
  1.  Q
  1.  ;
  1.  I $E(IOST,1,2)="C-",$Y>1,PAGE>1 D PAUSE Q:IBQUIT
  1.  I PAGE>1 W @IOF
  1.  W !,"List of Encounter Forms and their Use by Clinics",?IOM-30,IBHDT,"  PAGE ",PAGE
  1.  W !,"For Division: ",$G(DIVNAM)
  1.  W !,"FORM NAME",?32,"CLINIC",?59,"DIVISION",?81,"FORM USAGE"
  1.  W !,$TR($J(" ",IOM)," ","-")
  1.  S PAGE=PAGE+1
  1.  Q
  1.  ;
  1. PAUSE ; -- hold screen
  1.  N DIR,X,Y
  1.  F  Q:$Y>(IOSL-2)  W !
  1.  S DIR(0)="E" D ^DIR S IBQUIT=$S(+Y:0,1:1)
  1.  Q
  1.  ;
  1. TYPE(IDX) ;
  1.  ; -- type of form
  1.  ;    input cross reference from print Manager Clinic Setups (409.95)
  1.  ;    output name of type of form
  1.  ;    IDX="C","D","E","F","G","H","I","J"
  1.  ;
  1.  N X
  1.  S IDX=$E(IDX,1)
  1.  S X="" I IDX="" G TYPEQ
  1.  S X=$S(IDX="C":"Basic Form",IDX="D":"Supplmntl form - Establshed Pt.",IDX="E":"Supplmntl Form - First Visit",IDX="F":"Form w/o Patient Data",IDX="G":"Supplmntl Form #1",1:"")
  1.  I X="" S X=$S(IDX="H":"Reserved",IDX="I":"Supplmntl Form #2",IDX="J":"Supplmntl Form #3",1:"")
  1. TYPEQ   Q X