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

IBDF18D.m

Go to the documentation of this file.
  1. IBDF18D ;ALB/CJM/AAS - ENCOUNTER FORM - form type utilities ;04-OCT-94
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**5**;APR 24, 1997
  1. ;
  1. FORMTYPE(SOURCE) ;creates an entry in the FORM DEFINITION TABLE
  1. ; -- input SOURCE = the source of the form, ie
  1. ; IB=1
  1. ; PANDAS=2
  1. ; TELEFORM=3
  1. ; OTHER=99
  1. ; -- Output Returns the ien of the table created, "" if not created
  1. ;
  1. Q:'SOURCE ""
  1. N IBFORMID,ID,NODE,DIC,DIE,DA,DINUM,D0,DD,DIK,DINUM,DLAYGO
  1. S ID=""
  1. ;
  1. L +^IBD(357.97,1,.01):3
  1. S ID=$P($G(^IBD(357.97,1,0)),"^")
  1. K DIC,D0,DD,DA,DO
  1. S DIC="^IBD(357.95,",DIC(0)="L",DLAYGO=357.95
  1. F ID=ID+1:1 L:$D(^IBD(357.95,(ID-1))) -^IBD(357.95,(ID-1)) I ID>0,'$D(^IBD(357.95,ID)) L +^IBD(357.95,ID):1 I $T,'$D(^IBD(357.95,ID)) S (X,DINUM)=ID D FILE^DICN I +Y>0 L -^IBD(357.95,ID) Q
  1. S $P(^IBD(357.97,1,0),"^")=ID
  1. L -^IBD(357.97,1,.01)
  1. K DIC,DIE,DA,DINUM,DLAYGO,DO,D0,DD
  1. S IBFORMID=$S(+Y<0:"",1:+Y) I 'IBFORMID D LOGERR^IBDF18E2(3570003)
  1. ;
  1. I IBFORMID D
  1. .S $P(^IBD(357.95,IBFORMID,0),"^",3)=SOURCE,^IBD(357.95,IBFORMID,1,0)="^357.951I^0^0",^IBD(357.95,IBFORMID,2,0)="^357.952I^0^0",^IBD(357.95,IBFORMID,3,0)="^357.953^0^0"
  1. .S DIK="^IBD(357.95,",DA=IBFORMID D IX1^DIK
  1. K DIK,X,DA
  1. Q IBFORMID